Return to b3scr.c CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / B / src / bint

Annotation of 43BSD/contrib/B/src/bint/b3scr.c, revision 1.1

1.1     ! root        1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
        !             2: 
        !             3: /*
        !             4:   $Header: b3scr.c,v 1.4 85/08/22 16:58:54 timo Exp $
        !             5: */
        !             6: 
        !             7: /* B input/output handling */
        !             8: 
        !             9: #include "b.h"
        !            10: #include "b0fea.h"
        !            11: #include "b1mem.h"
        !            12: #include "b1obj.h"
        !            13: #include "b0con.h" /*for CLEAR_EOF*/
        !            14: #include "b2nod.h"
        !            15: #include "b2syn.h"
        !            16: #include "b2par.h"
        !            17: #include "b3scr.h"
        !            18: #include "b3err.h"
        !            19: #include "b3fil.h"
        !            20: #include "b3typ.h"
        !            21: #include "b3env.h"
        !            22: #include "b3sem.h"
        !            23: #include "b3int.h"
        !            24: #ifdef SETJMP
        !            25: #include <setjmp.h>
        !            26: #endif
        !            27: 
        !            28: Visible bool interactive;
        !            29: Visible bool rd_interactive;
        !            30: Visible value iname= Vnil;     /* input name */
        !            31: Visible bool filtered= No;
        !            32: Visible bool outeractive;
        !            33: #ifdef SETJMP
        !            34: Visible bool awaiting_input= No;
        !            35: Visible jmp_buf read_interrupt;
        !            36: #endif
        !            37: Visible bool at_nwl= Yes;      /*Yes if currently at the start of an output line*/
        !            38: Hidden bool woa, wnwl;         /*was outeractive, was at_nwl */
        !            39: Hidden bool last_was_text= No; /*Yes if last value written was a text*/
        !            40: 
        !            41: Visible bool Eof;
        !            42: FILE *ofile= stdout;
        !            43: FILE *ifile;           /* input file */
        !            44: FILE *sv_ifile;                /* copy of ifile for restoring after reading unit */
        !            45: 
        !            46: /******************************* Output *******************************/
        !            47: 
        !            48: #ifndef INTEGRATION
        !            49: 
        !            50: Hidden Procedure putch(c) char c; {
        !            51:        if (still_ok) {
        !            52:                putc(c, ofile);
        !            53:                if (c == '\n') at_nwl= Yes;
        !            54:                else at_nwl= No;
        !            55:        }
        !            56: }
        !            57: 
        !            58: #else
        !            59: 
        !            60: Hidden int ocol;       /* Current output column */
        !            61: 
        !            62: Hidden Procedure putch(c) char c; {
        !            63:        if (still_ok) {
        !            64:                putc(c, ofile);
        !            65:                if (c == '\n') { at_nwl= Yes; ocol= 0; }
        !            66:                else {
        !            67:                        if (at_nwl) { ocol= 0; at_nwl= No;}
        !            68:                        ++ocol;
        !            69:                }
        !            70:        }
        !            71: }
        !            72: 
        !            73: #endif
        !            74: 
        !            75: Visible Procedure newline() {
        !            76:        putch('\n');
        !            77:        fflush(stdout);
        !            78: }
        !            79: 
        !            80: Hidden Procedure line() {
        !            81:        if (!at_nwl) newline();
        !            82: }
        !            83: 
        !            84: Visible Procedure wri_space() {
        !            85:        putch(' ');
        !            86: }
        !            87: 
        !            88: Visible Procedure writ(v) value v; {
        !            89:        wri(v, Yes, Yes, No);
        !            90:        fflush(stdout);
        !            91: }
        !            92: 
        !            93: #define Putch_sp() {if (!perm) putch(' ');}
        !            94: 
        !            95: Hidden int intsize(v) value v; {
        !            96:        value s= size(v); int len=0;
        !            97:        if (large(s)) error(MESS(3800, "value too big to output"));
        !            98:        else len= intval(s);
        !            99:        release(s);
        !           100:        return len;
        !           101: }
        !           102: 
        !           103: Hidden bool lwt;
        !           104: 
        !           105: Visible Procedure wri(v, coll, outer, perm) value v; bool coll, outer, perm; {
        !           106:        if (outer && !at_nwl && (!Is_text(v) || !last_was_text)
        !           107:                  && (!Is_compound(v) || !coll)) putch(' ');
        !           108:        lwt= No;
        !           109:        if (Is_number(v)) {
        !           110:                if (perm) printnum(ofile, v);
        !           111:                else {
        !           112:                        string cp= convnum(v);
        !           113:                        while(*cp && still_ok) putch(*cp++);
        !           114:                }
        !           115:        } else if (Is_text(v)) {
        !           116: #ifndef INTEGRATION
        !           117:                wrtext(putch, v, outer ? '\0' : '"');
        !           118: #else
        !           119:                value ch; char c; int k, len= Length(v);
        !           120: #define QUOTE '"'
        !           121:                if (!outer) putch(QUOTE);
        !           122:                for (k=0; k<len && still_ok; k++) {
        !           123:                        ch= thof(k+1, v);
        !           124:                        putch(c= charval(ch));
        !           125:                        if (!outer && (c == QUOTE || c == '`'))
        !           126:                                putch(c);
        !           127:                        release(ch);
        !           128:                }
        !           129:                if (!outer) putch(QUOTE);
        !           130: #endif
        !           131:                lwt= outer;
        !           132:        } else if (Is_compound(v)) {
        !           133:                intlet k, len= Nfields(v);
        !           134:                outer&= coll;
        !           135:                if (!coll) putch('(');
        !           136:                for (k=0; k<len && still_ok; k++) {
        !           137:                        wri(*Field(v, k), No, outer, perm);
        !           138:                        if (!Lastfield(k)) {
        !           139:                                if (!outer){
        !           140:                                        putch(',');
        !           141:                                        Putch_sp();
        !           142:                                }
        !           143:                        }
        !           144:                }
        !           145:                if (!coll) putch(')');
        !           146:        } else if (Is_list(v) || Is_ELT(v)) {
        !           147:                value ve; int k, len= intsize(v);
        !           148:                putch('{');
        !           149:                for (k=0; k<len && still_ok; k++) {
        !           150:                        wri(ve= thof(k+1, v), No, No, perm);
        !           151:                        release(ve);
        !           152:                        if (!Last(k)) {
        !           153:                                putch(';');
        !           154:                                Putch_sp();
        !           155:                        }
        !           156:                }
        !           157:                putch('}');
        !           158:        } else if (Is_table(v)) {
        !           159:                int k, len= intsize(v);
        !           160:                putch('{');
        !           161:                for (k=0; k<len && still_ok; k++) {
        !           162:                        putch('['); wri(*key(v, k), Yes, No, perm);
        !           163:                        putch(']'); putch(':'); Putch_sp();
        !           164:                        wri(*assoc(v, k), No, No, perm);
        !           165:                        if (!Last(k)) {
        !           166:                                putch(';');
        !           167:                                Putch_sp();
        !           168:                        }
        !           169:                }
        !           170:                putch('}');
        !           171:        } else {
        !           172:                if (bugs || testing) { putch('?'); putch(Type(v)); putch('?'); }
        !           173:                else syserr(MESS(3801, "writing value of unknown type"));
        !           174:        }
        !           175:        last_was_text= lwt;
        !           176: #ifdef IBMPC
        !           177:        if (interrupted) clearerr(ofile);
        !           178: #endif
        !           179: }
        !           180: 
        !           181: /***************************** Input ****************************************/
        !           182: 
        !           183: Hidden char cmbuf[CMBUFSIZE]; /* for commands */
        !           184: Hidden char rdbuf[RDBUFSIZE]; /* for READ EG/RAW */
        !           185: 
        !           186: #ifndef INTEGRATION
        !           187: Visible string cmd_prompt= ">>> "; /* commands  */
        !           188: Visible string eg_prompt=  "?\b";  /* READ EG   */
        !           189: Visible string raw_prompt= "?\b";  /* READ RAW  */
        !           190: Visible string qn_prompt=  "?\b";  /* questions */
        !           191: #else
        !           192: Hidden literal cmd_prompt= '>'; /* commands  */
        !           193: Hidden literal eg_prompt=  'E';  /* READ EG   */
        !           194: Hidden literal raw_prompt= 'R';  /* READ RAW  */
        !           195: Hidden literal qn_prompt= 'Y';  /* questions */
        !           196: Visible literal unit_prompt= ':'; /* units */
        !           197: Visible literal tar_prompt= '='; /* targets */
        !           198: #endif
        !           199: 
        !           200: /* Read a line; EOF only allowed if not interactive, in which case eof set */
        !           201: /* Returns the line input                                                  */
        !           202: /* This is the only place where a long jump is necessary                   */
        !           203: /* In other places, interrupts are just like procedure calls, and checks   */
        !           204: /* of still_ok and interrupted suffice: eventually the stack unwinds to the*/
        !           205: /* main loop in imm_command(). Here though, an interrupt must actually     */
        !           206: /* terminate the read. Hence the bool awaiting_input indicating if the     */
        !           207: /* long jump is necessary or not                                           */
        !           208: 
        !           209: #ifndef INTEGRATION
        !           210: 
        !           211: Hidden txptr read_line(should_prompt, prompt, cmd, eof, eof_message)
        !           212:  bool should_prompt, cmd, *eof; string prompt, eof_message; {
        !           213:        txptr buf, rp, bufend; intlet k; bool got= No;
        !           214:        FILE *f;
        !           215:        *eof= No;
        !           216:        if (cmd) { buf= cmbuf; bufend= &cmbuf[CMBUFSIZE-2]; }
        !           217:        else     { buf= rdbuf; bufend= &rdbuf[RDBUFSIZE-2]; }
        !           218: #ifdef SETJMP
        !           219:        if (setjmp(read_interrupt) != 0) {
        !           220:                awaiting_input= No;
        !           221:                return buf;
        !           222:        }
        !           223: #endif
        !           224:        while (!got) {
        !           225:                rp= buf;
        !           226: #ifdef SETJMP
        !           227:                awaiting_input= Yes;
        !           228: #endif
        !           229:                if (should_prompt) {
        !           230:                        if (cmd) {
        !           231:                                if (outeractive) {
        !           232:                                        line();
        !           233:                                        at_nwl= No;
        !           234:                                }
        !           235:                        }
        !           236:                        fprintf(stderr, prompt); fflush(stderr);
        !           237:                        f= stdin;
        !           238:                } else {
        !           239:                        f= ifile;
        !           240:                }
        !           241:                while ((k= getc(f)) != EOF && k != '\n') {
        !           242:                        *rp++= k;
        !           243:                        if (rp >= bufend) syserr(MESS(3802, "buffer overflow"));
        !           244:                }
        !           245: #ifdef SETJMP
        !           246:                awaiting_input= No;
        !           247: #endif
        !           248:                got= Yes; *rp++= '\n'; *rp= '\0';
        !           249:                if (k == EOF) {
        !           250:                        if (should_prompt) {
        !           251:                                if (filtered) {
        !           252:                                        bye(0); /*Editor has died*/
        !           253:                                } else {
        !           254:                                        fprintf(stderr, "\r*** %s\n", eof_message);
        !           255:                                        CLEAR_EOF;
        !           256:                                        if (outeractive) at_nwl= Yes;
        !           257:                                        got= No;
        !           258:                                }
        !           259:                        } else *eof= Yes;
        !           260:                }
        !           261:        }
        !           262:        if (should_prompt && outeractive && k == '\n') at_nwl= Yes;
        !           263:        return buf;
        !           264: }
        !           265: 
        !           266: #else INTEGRATION
        !           267: 
        !           268: Hidden intlet
        !           269: rd_fileline(nbuf, file, nbufend)
        !           270:        string nbuf, nbufend;
        !           271:        FILE *file;
        !           272: {
        !           273:        intlet k;
        !           274:        while ((k= getc(file)) != EOF && k != '\n') {
        !           275:                *nbuf++= k;
        !           276:                if (nbuf >= nbufend)
        !           277:                        syserr(MESS(3803, "buffer overflow rd_fileline()"));
        !           278:        }
        !           279:        *nbuf++= '\n'; *nbuf= '\0';
        !           280:        return k;
        !           281: }
        !           282: 
        !           283: Hidden intlet
        !           284: rd_bufline(nbuf, obuf, nbufend)
        !           285:        string nbuf, *obuf, nbufend;
        !           286: {
        !           287:        while (**obuf && **obuf != '\n') {
        !           288:                *nbuf++= **obuf; ++*obuf;
        !           289:                if (nbuf >= nbufend)
        !           290:                        syserr(MESS(3804, "buffer overflow rd_bufline()"));
        !           291:        }
        !           292:        *nbuf++= '\n'; *nbuf= '\0';
        !           293:        if (**obuf)  { ++*obuf; return '\n';}
        !           294:        else return EOF;
        !           295: }
        !           296: 
        !           297: Hidden string edcmdbuf;
        !           298: 
        !           299: Hidden txptr
        !           300: read_line(should_prompt, prompt, cmd, eof, eof_message)
        !           301:        bool should_prompt, cmd, *eof; literal prompt; string eof_message;
        !           302: {
        !           303:        txptr buf, rp, bufend; intlet k, indent= 0; bool got= No;
        !           304:        static string pedcmdbuf;
        !           305:        if (prompt == eg_prompt || prompt == raw_prompt) indent= ocol;
        !           306:        *eof= No;
        !           307:        if (cmd) { buf= cmbuf; bufend= &cmbuf[CMBUFSIZE-2]; }
        !           308:        else     { buf= rdbuf; bufend= &rdbuf[RDBUFSIZE-2]; }
        !           309: #ifdef SETJMP
        !           310:        if (setjmp(read_interrupt) != 0) {
        !           311:                awaiting_input= No;
        !           312:                return buf;
        !           313:        }
        !           314: #endif
        !           315:        while (!got) {
        !           316:                rp= buf; got= Yes;
        !           317: #ifdef SETJMP
        !           318:                awaiting_input= Yes;
        !           319: #endif
        !           320:                if (!should_prompt) {
        !           321:                        k= rd_fileline(rp, ifile, bufend);
        !           322:                        if (k == EOF) *eof= Yes;
        !           323:                } else {
        !           324:                        if (!edcmdbuf) {
        !           325:                                if (cmd && outeractive) { line(); at_nwl= No; }
        !           326:                                btop(&edcmdbuf, 0, prompt, indent);
        !           327:                                pedcmdbuf= edcmdbuf;
        !           328:                        }
        !           329:                        k= rd_bufline(rp, &pedcmdbuf, bufend);
        !           330:                        if (k == EOF) {
        !           331:                                freemem((ptr) edcmdbuf);
        !           332:                                edcmdbuf= (string) NULL;
        !           333:                                if (prompt != '>') got= No;
        !           334:                        } 
        !           335:                }
        !           336: #ifdef SETJMP
        !           337:                awaiting_input= No;
        !           338: #endif
        !           339:        }
        !           340: 
        !           341:        if (should_prompt && outeractive && k == '\n') at_nwl= Yes;
        !           342:        return buf;
        !           343: }
        !           344: 
        !           345: #endif INTEGRATION
        !           346: 
        !           347: /* Rather over-fancy routine to ask the user a question */
        !           348: /* Will anybody discover that you're only given 4 chances? */
        !           349: 
        !           350: Hidden char USE_YES_OR_NO[]=
        !           351:  "Answer with yes or no (or use interrupt to duck the question)";
        !           352: 
        !           353: Hidden char LAST_CHANCE[]=
        !           354:  "This is your last chance. Take it. I really don't know what you want.\n\
        !           355:     So answer the question";
        !           356: 
        !           357: Hidden char NO_THEN[]=
        !           358:  "Well, I shall assume that your refusal to answer the question means no!";
        !           359: 
        !           360: Visible bool is_intended(m) string m; {
        !           361:        char answer; intlet try; txptr tp; bool eof;
        !           362:        if (!interactive) return Yes;
        !           363:        if (outeractive) line();
        !           364:        for (try= 1; try<=4; try++){
        !           365:                if (try == 1 || try == 3) fprintf(stderr, "*** %s\n", m);
        !           366:                tp= read_line(Yes, qn_prompt, No, &eof, USE_YES_OR_NO);
        !           367:                skipsp(&tp);
        !           368:                answer= Char(tp);
        !           369:                if (answer == 'y' || answer == 'Y') return Yes;
        !           370:                if (answer == 'n' || answer == 'N') return No;
        !           371:                if (outeractive) line();
        !           372:                fprintf(stderr, "*** %s\n",
        !           373:                        try == 1 ? "Please answer with yes or no" :
        !           374:                        try == 2 ? "Just yes or no, please" :
        !           375:                        try == 3 ? LAST_CHANCE :
        !           376:                        NO_THEN);
        !           377:        } /* end for */
        !           378:        return No;
        !           379: }
        !           380: 
        !           381: /* Read_eg uses evaluation but it shouldn't.
        !           382:    Wait for a more general mechanism. */
        !           383: 
        !           384: Visible Procedure read_eg(l, t) loc l; btype t; {
        !           385:        context c; parsetree code;
        !           386:        parsetree r= NilTree; value rv= Vnil; btype rt= Vnil;
        !           387:        envtab svprmnvtab= Vnil;
        !           388:        txptr fcol_save= first_col, tx_save= tx;
        !           389:        do {
        !           390:                still_ok= Yes;
        !           391:                sv_context(&c);
        !           392:                if (cntxt != In_read) {
        !           393:                        release(read_context.uname);
        !           394:                        sv_context(&read_context);
        !           395:                }
        !           396:                svprmnvtab= prmnvtab == Vnil ? Vnil : prmnv->tab;
        !           397:                /* save scratch-pad copy because of following setprmnv() */
        !           398:                setprmnv();
        !           399:                cntxt= In_read;
        !           400:                first_col= tx= read_line(rd_interactive, eg_prompt, No,
        !           401:                        &Eof, "use interrupt to abort READ command");
        !           402:                if (still_ok && Eof)
        !           403:                        error(MESS(3805, "End of file encountered during READ command"));
        !           404:                if (!rd_interactive) f_lino++;
        !           405:                if (still_ok) {
        !           406:                        findceol();
        !           407:                        r= expr(ceol);
        !           408:                        if (still_ok) fix_nodes(&r, &code);
        !           409:                        rv= evalthread(code); release(r);
        !           410:                        rt= still_ok ? valtype(rv) : Vnil;
        !           411:                        if (svprmnvtab != Vnil) {
        !           412:                                prmnvtab= prmnv->tab;
        !           413:                                prmnv->tab= svprmnvtab;
        !           414:                        }
        !           415:                        set_context(&c);
        !           416:                        if (still_ok) must_agree(t, rt,
        !           417:        MESS(3806, "type of expression does not agree with that of EG sample"));
        !           418:                        release(rt);
        !           419:                }
        !           420:                if (!still_ok && rd_interactive && !interrupted)
        !           421:                        fprintf(stderr, "*** Please try again\n");
        !           422:        } while (!interrupted && !still_ok && rd_interactive);
        !           423:        if (still_ok) put(rv, l);
        !           424:        first_col= fcol_save;
        !           425:        tx= tx_save;
        !           426:        release(rv);
        !           427: }
        !           428: 
        !           429: Visible Procedure read_raw(l) loc l; {
        !           430:        value r; bool eof;
        !           431:        txptr line= read_line(rd_interactive, raw_prompt, No, &eof, 
        !           432:                        "use interrupt to abort READ t RAW");
        !           433:        if (still_ok && eof) error(MESS(3807, "End of file encountered during READ t RAW"));
        !           434:        if (!rd_interactive) f_lino++;
        !           435:        if (still_ok) {
        !           436:                txptr rp= line;
        !           437:                while (*rp != '\n') rp++;
        !           438:                *rp= '\0';
        !           439:                r= mk_text(line);
        !           440:                put(r, l);
        !           441:                release(r);
        !           442:        }
        !           443: }
        !           444: 
        !           445: Visible txptr getline() {
        !           446:        bool should_prompt=
        !           447:                interactive && sv_ifile == ifile;
        !           448:        return read_line(should_prompt, cmd_prompt, Yes, &Eof,
        !           449:                        "use QUIT to end session");
        !           450: }
        !           451: 
        !           452: /******************************* Files ******************************/
        !           453: 
        !           454: Visible Procedure redirect(of) FILE *of; {
        !           455:        ofile= of;
        !           456:        if (of == stdout) {
        !           457:                outeractive= woa;
        !           458:                at_nwl= wnwl;
        !           459:        } else {
        !           460:                woa= outeractive; outeractive= No;
        !           461:                wnwl= at_nwl; at_nwl= Yes;
        !           462:        }
        !           463: }
        !           464: 
        !           465: Visible Procedure vs_ifile() {
        !           466:        ifile= sv_ifile;
        !           467: }
        !           468: 
        !           469: Visible Procedure re_screen() {
        !           470:        sv_ifile= ifile;
        !           471:        interactive= f_interactive(ifile) || (ifile == stdin && filtered);
        !           472:        Eof= No;
        !           473: }
        !           474: 
        !           475: /* initscr is a reserved name of CURSES */
        !           476: Visible Procedure init_scr() {
        !           477:        outeractive= f_interactive(stdout) || filtered;
        !           478:        rd_interactive= f_interactive(stdin) || filtered;
        !           479:        rdbuf[0]= '\n'; tx= rdbuf;
        !           480: }
        !           481: 
        !           482: Visible Procedure
        !           483: endscr()
        !           484: {
        !           485: #ifdef INTEGRATION
        !           486:        if (edcmdbuf) {
        !           487:                freemem((ptr) edcmdbuf);
        !           488:                edcmdbuf= (string) NULL;
        !           489:        }
        !           490: #endif
        !           491: }

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