home *** CD-ROM | disk | FTP | other *** search
/ Vectronix 2 / VECTRONIX2.iso / FILES_01 / X_PROLOG.LZH / X_PROLOG / SOURCES / BIIO.C < prev    next >
Encoding:
C/C++ Source or Header  |  1990-08-13  |  8.3 KB  |  449 lines
  1. /*
  2.  
  3.  *        X PROLOG  Vers. 2.0
  4.  
  5.  *
  6.  
  7.  *
  8.  
  9.  *    Written by :     Andreas Toenne
  10.  
  11.  *            CS Dept. , IRB
  12.  
  13.  *            University of Dortmund, W-Germany
  14.  
  15.  *            <at@unido.uucp>
  16.  
  17.  *            <....!seismo!unido!at>
  18.  
  19.  *            <at@unido.bitnet>
  20.  
  21.  *
  22.  
  23.  *    Copyright :    This software is copyrighted by Andreas Toenne.
  24.  
  25.  *            Permission is granted hereby to copy the entire
  26.  
  27.  *            package including this copyright notice without fee.
  28.  
  29.  *
  30.  
  31.  */
  32.  
  33.  
  34.  
  35. #include <stdio.h>
  36.  
  37. #include <ctype.h> 
  38.  
  39. #include "prolog.h"
  40.  
  41. #include "extern.h"
  42.  
  43. #include "error.h"
  44.  
  45.  
  46.  
  47. extern term *int_copy();        /* terms */
  48.  
  49. extern term *term_copy();        /* terms */
  50.  
  51. extern term *read_term();        /* reader */
  52.  
  53. extern void display();            /* reader */
  54.  
  55. extern long eval();            /* bimath */
  56.  
  57.  
  58.  
  59. /*    SEE(stream)    */
  60.  
  61.  
  62.  
  63. short bisee(args)
  64.  
  65. term *args[];
  66.  
  67. {
  68.  
  69.     short i;
  70.  
  71.     
  72.  
  73.     if (ISVAR(args[0]))        /* no var arguments */
  74.  
  75.         BIERROR(EBAD);
  76.  
  77.         
  78.  
  79.     if (! ISATOM(args[0]))        /* need an atomic argument */
  80.  
  81.         BIERROR(EBAD);
  82.  
  83.  
  84.  
  85.     for (i=0; i<MAXSTREAMS; i++)
  86.  
  87.         if (!(streams[i].status & CLOSED)
  88.  
  89.              && FUNC(args[0]) == FUNC(streams[i].atom)
  90.  
  91.              && streams[i].status & INPUT)
  92.  
  93.             break;
  94.  
  95.     if (i == MAXSTREAMS)            /* new stream */
  96.  
  97.     {
  98.  
  99.         for (i=0; i<MAXSTREAMS && !(streams[i].status & CLOSED); i++);
  100.  
  101.         if (i == MAXSTREAMS)        /* no slot left */
  102.  
  103.             FILEERROR(EIO);        /* signal an error */
  104.  
  105.         in = (stream *)&(streams[i]);
  106.  
  107.         in->atom = args[0];
  108.  
  109.         if ((in->fp = fopen(NAME(args[0]), "r")) == NULL)
  110.  
  111.             FILEERROR(EIO);
  112.  
  113.         in->status = INPUT;
  114.  
  115.     }
  116.  
  117.     else
  118.  
  119.     {    
  120.  
  121.         in = (stream *)&(streams[i]);
  122.  
  123.         if (ISFOROUTPUT(in) && FUNC(in->atom) != USERFUNCTOR)
  124.  
  125.             FILEERROR(EIO);
  126.  
  127.     }
  128.  
  129.     return(TRUE);
  130.  
  131. }
  132.  
  133.  
  134.  
  135. /*    SEEING(stream)    */
  136.  
  137.  
  138.  
  139. short biseeing(args)
  140.  
  141. term *args[];
  142.  
  143. {
  144.  
  145.     if (ISVAR(args[0]))        /* must bind stream with in */
  146.  
  147.     {
  148.  
  149.         BIND_VAR(args[0], in->atom);
  150.  
  151.         return(TRUE);
  152.  
  153.     }
  154.  
  155.     else
  156.  
  157.     {
  158.  
  159.         if (! ISATOM(args[0]))
  160.  
  161.             BIERROR(EBAD);
  162.  
  163.         return(FUNC(args[0]) == FUNC(in->atom));
  164.  
  165.     }
  166.  
  167. }
  168.  
  169.  
  170.  
  171. /*    SEEN    */
  172.  
  173.  
  174.  
  175. short biseen(/* args */)
  176.  
  177. /* term *args[]; */
  178.  
  179. {
  180.  
  181.     if (ISCLOSED(in))        /* cannot close closed stream */
  182.  
  183.         FILEERROR(EIO);
  184.  
  185.         
  186.  
  187.     if (FUNC(in->atom) == USERFUNCTOR)/* cannot close the user stream */
  188.  
  189.         return(FALSE);
  190.  
  191.     else
  192.  
  193.     {
  194.  
  195.         if (fclose(in->fp) <0)    /* error while closeing */
  196.  
  197.             FILEERROR(EIO);
  198.  
  199.         in->status |= CLOSED;
  200.  
  201.         in = (stream *)(&(streams[0]));
  202.  
  203.     }
  204.  
  205.     return(TRUE);
  206.  
  207. }
  208.  
  209. /*    TELL(stream)    */
  210.  
  211.  
  212.  
  213. short bitell(args)
  214.  
  215. term *args[];
  216.  
  217. {
  218.  
  219.     short i;
  220.  
  221.  
  222.  
  223.     if (ISVAR(args[0]))        /* no var arguments */
  224.  
  225.         BIERROR(EBAD);    
  226.  
  227.         
  228.  
  229.     if (! ISATOM(args[0]))
  230.  
  231.         BIERROR(EBAD);
  232.  
  233.  
  234.  
  235.     for (i=0; i<MAXSTREAMS; i++)
  236.  
  237.         if (!(streams[i].status & CLOSED)
  238.  
  239.              && FUNC(args[0]) == FUNC(streams[i].atom)
  240.  
  241.              && streams[i].status & OUTPUT)
  242.  
  243.             break;
  244.  
  245.     if (i == MAXSTREAMS)            /* new stream */
  246.  
  247.     {
  248.  
  249.         for (i=0; i<MAXSTREAMS && !(streams[i].status & CLOSED); i++);
  250.  
  251.         if (i == MAXSTREAMS)        /* no slot left */
  252.  
  253.             FILEERROR(EIO);        /* signal an error */
  254.  
  255.         out = (stream *)(&(streams[i]));
  256.  
  257.         out->atom = args[0];
  258.  
  259.         if ((out->fp = fopen(NAME(args[0]), "w")) == NULL)
  260.  
  261.             FILEERROR(EIO);
  262.  
  263.         out->status = OUTPUT;
  264.  
  265.     }
  266.  
  267.     else
  268.  
  269.     {
  270.  
  271.         out = (stream *)(&(streams[i]));
  272.  
  273.         if (ISFORINPUT(out) && FUNC(out->atom) != USERFUNCTOR)
  274.  
  275.             FILEERROR(EIO);
  276.  
  277.     }
  278.  
  279.     return(TRUE);
  280.  
  281. }
  282.  
  283.  
  284.  
  285. /*    TELLING(stream)    */
  286.  
  287.  
  288.  
  289. short bitelling(args)
  290.  
  291. term *args[];
  292.  
  293. {
  294.  
  295.     if (ISVAR(args[0]))        /* must bind stream with out */
  296.  
  297.     {
  298.  
  299.         BIND_VAR(args[0], out->atom);
  300.  
  301.         return(TRUE);
  302.  
  303.     }
  304.  
  305.     else
  306.  
  307.     {
  308.  
  309.         if (! ISATOM(args[0]))
  310.  
  311.             BIERROR(EBAD);
  312.  
  313.         return(FUNC(args[0]) == FUNC(out->atom));
  314.  
  315.     }
  316.  
  317. }
  318.  
  319.  
  320.  
  321. /*    TOLD    */
  322.  
  323.  
  324.  
  325. short bitold(/* args */)
  326.  
  327. /* term *args[]; */
  328.  
  329. {
  330.  
  331.     if (ISCLOSED(out))        /* cannot close closed stream */
  332.  
  333.         FILEERROR(EIO);
  334.  
  335.         
  336.  
  337.     if (FUNC(out->atom) == USERFUNCTOR)/* cannot close the user stream */
  338.  
  339.         return(FALSE);
  340.  
  341.     else
  342.  
  343.     {
  344.  
  345.         if (fclose(out->fp) <0)    /* error while closeing */
  346.  
  347.             FILEERROR(EIO);
  348.  
  349.         out->status = CLOSED;
  350.  
  351.         out = (stream *)(&(streams[1]));
  352.  
  353.     }
  354.  
  355.     return(TRUE);
  356.  
  357. }
  358.  
  359.  
  360.  
  361. /*    CLOSE(stream)    */
  362.  
  363.  
  364.  
  365. biclose(args)
  366.  
  367. term *args[];
  368.  
  369. {
  370.  
  371.     if (! ISATOM(args[0]))
  372.  
  373.         BIERROR(EBAD);
  374.  
  375.         
  376.  
  377.     if (FUNC(args[0]) == FUNC(in->atom))
  378.  
  379.         return(biseen());
  380.  
  381.     else
  382.  
  383.         if (FUNC(args[0]) == FUNC(out->atom))
  384.  
  385.             return(bitold());
  386.  
  387.         else
  388.  
  389.             FILEERROR(EIO);
  390.  
  391. }
  392.  
  393.  
  394.  
  395. /*    FILEERRORS    */
  396.  
  397.  
  398.  
  399. short bifileerrors(/* args */)
  400.  
  401. /* term *args[]; */
  402.  
  403. {
  404.  
  405.     io_errors = 1;
  406.  
  407.     return(TRUE);
  408.  
  409. }
  410.  
  411.  
  412.  
  413. /*    NOFILERRORS    */
  414.  
  415.  
  416.  
  417. short binofileerrors(/* args */)
  418.  
  419. /* term *args[]; */
  420.  
  421. {
  422.  
  423.     io_errors = 0;
  424.  
  425.     return(TRUE);
  426.  
  427. }
  428.  
  429.  
  430.  
  431. /*    EXISTS(stream)    */
  432.  
  433.  
  434.  
  435. short biexists(args)
  436.  
  437. term *args[];
  438.  
  439. {
  440.  
  441.     if (! ISATOM(args[0]))
  442.  
  443.         BIERROR(EBAD);
  444.  
  445.         
  446.  
  447.     return(!access(NAME(args[0]), 0));
  448.  
  449. }
  450.  
  451.  
  452.  
  453. /*    RENAME(old, new) */
  454.  
  455.  
  456.  
  457. short birename(args)
  458.  
  459. term *args[];
  460.  
  461. {
  462.  
  463.     term *old;
  464.  
  465.     term *new;
  466.  
  467.     char string[255];
  468.  
  469.     
  470.  
  471.     old = args[0];
  472.  
  473.     new = args[1];
  474.  
  475.  
  476.  
  477.     if (! ISATOM(old) || ! ISATOM(new))
  478.  
  479.         BIERROR(EBAD);
  480.  
  481.             
  482.  
  483.     if (FUNC(new) == NILFUNCTOR)
  484.  
  485.     {
  486.  
  487.         if (unlink(NAME(old)) < 0)
  488.  
  489.             FILEERROR(EIO);
  490.  
  491.         return(TRUE);
  492.  
  493.     }
  494.  
  495.     sprintf(string, "mv %s %s", NAME(old), NAME(new));
  496.  
  497.     if (system(string))
  498.  
  499.         FILEERROR(EIO);
  500.  
  501.     return(TRUE);
  502.  
  503. }
  504.  
  505.  
  506.  
  507. /*    NL    */
  508.  
  509.  
  510.  
  511. short binl( /* args */ )
  512.  
  513. /* term *args[]; */
  514.  
  515. {
  516.  
  517.     putc('\n', out->fp);
  518.  
  519.     return(TRUE);
  520.  
  521. }
  522.  
  523.  
  524.  
  525. /*    GET0( ORD )    */
  526.  
  527.     
  528.  
  529. short biget0(args)
  530.  
  531. term *args[];
  532.  
  533. {
  534.  
  535.     term *t;
  536.  
  537.     
  538.  
  539.     if (! ISVAR(args[0]) && ! ISINT(args[0]))
  540.  
  541.         BIERROR(EBAD);
  542.  
  543.  
  544.  
  545.     if (ISATEOF(in))        /* already at the end-of-file */
  546.  
  547.         FILEERROR(EEOF);
  548.  
  549.  
  550.  
  551.     if ((lastc = getc(in->fp)) == EOF)     /* at EOF */
  552.  
  553.     {
  554.  
  555.         in->status |= SEOF;
  556.  
  557.         t = EOFATOM;
  558.  
  559.     }
  560.  
  561.     else
  562.  
  563.         t = int_copy((long)lastc);
  564.  
  565.  
  566.  
  567.     if (ISVAR(args[0]))
  568.  
  569.     {
  570.  
  571.         BIND_VAR(args[0], t);
  572.  
  573.         return(TRUE);
  574.  
  575.     }
  576.  
  577.     else
  578.  
  579.         return(VALUE(args[0]) == VALUE(t));
  580.  
  581. }
  582.  
  583.  
  584.  
  585. /*    GET( ORD )    */
  586.  
  587.     
  588.  
  589. short biget(args)
  590.  
  591. term *args[];
  592.  
  593. {
  594.  
  595.     term *t;
  596.  
  597.     
  598.  
  599.     if (! ISVAR(args[0]) && ! ISINT(args[0]))
  600.  
  601.         BIERROR(EBAD);
  602.  
  603.  
  604.  
  605.     if (ISATEOF(in))        /* already at the end-of-file */
  606.  
  607.         FILEERROR(EEOF);
  608.  
  609.  
  610.  
  611.     while ((lastc = getc(in->fp)) != EOF && lastc < ' ');
  612.  
  613.     if (lastc  == EOF)            /* at EOF */
  614.  
  615.     {
  616.  
  617.         in->status |= SEOF;
  618.  
  619.         t = EOFATOM;
  620.  
  621.     }
  622.  
  623.     else
  624.  
  625.         t = int_copy((long)lastc);
  626.  
  627.  
  628.  
  629.     if (ISVAR(args[0]))
  630.  
  631.     {
  632.  
  633.         BIND_VAR(args[0], t);
  634.  
  635.         return(TRUE);
  636.  
  637.     }
  638.  
  639.     else
  640.  
  641.         return(VALUE(args[0]) == VALUE(t));
  642.  
  643. }
  644.  
  645.  
  646.  
  647. /*    SKIP ( ORD )    */
  648.  
  649.  
  650.  
  651. short biskip(args)
  652.  
  653. term *args[];
  654.  
  655. {
  656.  
  657.     char c;
  658.  
  659.     
  660.  
  661.     if (! ISINT(args[0]))        /* not proper argument */
  662.  
  663.         BIERROR(EBAD);
  664.  
  665.  
  666.  
  667.     if (ISATEOF(in))        /* already at the end-of-file */
  668.  
  669.         FILEERROR(EEOF);
  670.  
  671.  
  672.  
  673.     while ((c = getc(in->fp)) != EOF && c != (char)VALUE(args[0]));
  674.  
  675.     if (c  == EOF)            /* at EOF */
  676.  
  677.     {
  678.  
  679.         in->status |= SEOF;
  680.  
  681.         return(FALSE);
  682.  
  683.     }
  684.  
  685.     return(TRUE);
  686.  
  687. }
  688.  
  689.  
  690.  
  691. /*    PUT (ord)    */
  692.  
  693.  
  694.  
  695. short biput(args)
  696.  
  697. term *args[];
  698.  
  699. {
  700.  
  701.     short l;
  702.  
  703.     
  704.  
  705.     l = (short)eval(args[0]);
  706.  
  707.     if (c_errno)
  708.  
  709.         return(FALSE);
  710.  
  711.     putc(l, out->fp);
  712.  
  713.     return(TRUE);
  714.  
  715. }
  716.  
  717.  
  718.  
  719. /*    TAB (ord)    */
  720.  
  721.  
  722.  
  723. short bitab(args)
  724.  
  725. term *args[];
  726.  
  727. {
  728.  
  729.     short i;
  730.  
  731.     
  732.  
  733.     i = (short)eval(args[0]);
  734.  
  735.     if (c_errno)
  736.  
  737.         return(FALSE);
  738.  
  739.         
  740.  
  741.     while (i--)
  742.  
  743.         putc(' ', out->fp);
  744.  
  745.     return(TRUE);
  746.  
  747. }
  748.  
  749.  
  750.  
  751. /*    OP ( prio, operator, name)    */
  752.  
  753.  
  754.  
  755. short biop(args)
  756.  
  757. term *args[];
  758.  
  759. {
  760.  
  761.     unsigned short pre;
  762.  
  763.     
  764.  
  765.     if (!ISINT(args[0]))
  766.  
  767.         BIERROR(EBAD);
  768.  
  769.     if (!ISATOM(args[1]) || !ISATOM(args[2]))
  770.  
  771.         BIERROR(EBAD);
  772.  
  773.         
  774.  
  775.     pre = (unsigned short)VALUE(args[0]);
  776.  
  777.     if (pre < 0 || pre > 255)    /* preceedence out of range */
  778.  
  779.         return(FALSE);
  780.  
  781.     add_operator(NAME(args[2]), FUNC(args[1]), pre);
  782.  
  783.     return(TRUE);
  784.  
  785. }
  786.  
  787.  
  788.  
  789. /*    READ ( term ) */
  790.  
  791.  
  792.  
  793. short biread(args)
  794.  
  795. term *args[];
  796.  
  797. {
  798.  
  799.     term *t;
  800.  
  801.  
  802.  
  803.     if (FUNC(in->atom) == USERFUNCTOR)
  804.  
  805.     {
  806.  
  807.         clearerr(in->fp);
  808.  
  809.         in->status = INPUT;    /* clear errors */
  810.  
  811.     }
  812.  
  813.     
  814.  
  815.     if (ISATEOF(in))        /* already at the end-of-file */
  816.  
  817.         FILEERROR(EEOF);
  818.  
  819.  
  820.  
  821.     t = read_term();        /* read it */
  822.  
  823.     if (c_errno == EEOF)        /* we reached EOF */
  824.  
  825.     {
  826.  
  827.         t = EOFATOM;
  828.  
  829.         c_errno = 0;        /* reset the error */
  830.  
  831.     }
  832.  
  833.     if (!t || c_errno)        /* something strange */
  834.  
  835.         return(FALSE);
  836.  
  837.  
  838.  
  839.     return(term_unify(args[0], Topenv, t, Topenv));
  840.  
  841. }
  842.  
  843.  
  844.  
  845. /*    WRITE ( term )    */
  846.  
  847.  
  848.  
  849. short biwrite(args)
  850.  
  851. term *args[];
  852.  
  853. {
  854.  
  855.     display(args[0], Topenv, 255, TRUE, FALSE);
  856.  
  857.     return(TRUE);
  858.  
  859. }
  860.  
  861.  
  862.  
  863. /*    WRITEQ ( term )    */
  864.  
  865.  
  866.  
  867. short biwriteq(args)
  868.  
  869. term *args[];
  870.  
  871. {
  872.  
  873.     display(args[0], Topenv, 255, TRUE, TRUE);
  874.  
  875.     return(TRUE);
  876.  
  877. }
  878.  
  879.  
  880.  
  881. /*    DISPLAY ( term ) */
  882.  
  883.  
  884.  
  885. short bidisplay(args)
  886.  
  887. term *args[];
  888.  
  889. {
  890.  
  891.     display(args[0], Topenv, 255, FALSE, FALSE);
  892.  
  893.     return(TRUE);
  894.  
  895. }
  896.  
  897.