home *** CD-ROM | disk | FTP | other *** search
/ Vectronix 2 / VECTRONIX2.iso / FILES_01 / X_PROLOG.LZH / X_PROLOG / SOURCES / BIIO.C < prev    next >
C/C++ Source or Header  |  1990-08-13  |  9KB  |  449 lines
  1. /*
  2.  *        X PROLOG  Vers. 2.0
  3.  *
  4.  *
  5.  *    Written by :     Andreas Toenne
  6.  *            CS Dept. , IRB
  7.  *            University of Dortmund, W-Germany
  8.  *            <at@unido.uucp>
  9.  *            <....!seismo!unido!at>
  10.  *            <at@unido.bitnet>
  11.  *
  12.  *    Copyright :    This software is copyrighted by Andreas Toenne.
  13.  *            Permission is granted hereby to copy the entire
  14.  *            package including this copyright notice without fee.
  15.  *
  16.  */
  17.  
  18. #include <stdio.h>
  19. #include <ctype.h> 
  20. #include "prolog.h"
  21. #include "extern.h"
  22. #include "error.h"
  23.  
  24. extern term *int_copy();        /* terms */
  25. extern term *term_copy();        /* terms */
  26. extern term *read_term();        /* reader */
  27. extern void display();            /* reader */
  28. extern long eval();            /* bimath */
  29.  
  30. /*    SEE(stream)    */
  31.  
  32. short bisee(args)
  33. term *args[];
  34. {
  35.     short i;
  36.     
  37.     if (ISVAR(args[0]))        /* no var arguments */
  38.         BIERROR(EBAD);
  39.         
  40.     if (! ISATOM(args[0]))        /* need an atomic argument */
  41.         BIERROR(EBAD);
  42.  
  43.     for (i=0; i<MAXSTREAMS; i++)
  44.         if (!(streams[i].status & CLOSED)
  45.              && FUNC(args[0]) == FUNC(streams[i].atom)
  46.              && streams[i].status & INPUT)
  47.             break;
  48.     if (i == MAXSTREAMS)            /* new stream */
  49.     {
  50.         for (i=0; i<MAXSTREAMS && !(streams[i].status & CLOSED); i++);
  51.         if (i == MAXSTREAMS)        /* no slot left */
  52.             FILEERROR(EIO);        /* signal an error */
  53.         in = (stream *)&(streams[i]);
  54.         in->atom = args[0];
  55.         if ((in->fp = fopen(NAME(args[0]), "r")) == NULL)
  56.             FILEERROR(EIO);
  57.         in->status = INPUT;
  58.     }
  59.     else
  60.     {    
  61.         in = (stream *)&(streams[i]);
  62.         if (ISFOROUTPUT(in) && FUNC(in->atom) != USERFUNCTOR)
  63.             FILEERROR(EIO);
  64.     }
  65.     return(TRUE);
  66. }
  67.  
  68. /*    SEEING(stream)    */
  69.  
  70. short biseeing(args)
  71. term *args[];
  72. {
  73.     if (ISVAR(args[0]))        /* must bind stream with in */
  74.     {
  75.         BIND_VAR(args[0], in->atom);
  76.         return(TRUE);
  77.     }
  78.     else
  79.     {
  80.         if (! ISATOM(args[0]))
  81.             BIERROR(EBAD);
  82.         return(FUNC(args[0]) == FUNC(in->atom));
  83.     }
  84. }
  85.  
  86. /*    SEEN    */
  87.  
  88. short biseen(/* args */)
  89. /* term *args[]; */
  90. {
  91.     if (ISCLOSED(in))        /* cannot close closed stream */
  92.         FILEERROR(EIO);
  93.         
  94.     if (FUNC(in->atom) == USERFUNCTOR)/* cannot close the user stream */
  95.         return(FALSE);
  96.     else
  97.     {
  98.         if (fclose(in->fp) <0)    /* error while closeing */
  99.             FILEERROR(EIO);
  100.         in->status |= CLOSED;
  101.         in = (stream *)(&(streams[0]));
  102.     }
  103.     return(TRUE);
  104. }
  105. /*    TELL(stream)    */
  106.  
  107. short bitell(args)
  108. term *args[];
  109. {
  110.     short i;
  111.  
  112.     if (ISVAR(args[0]))        /* no var arguments */
  113.         BIERROR(EBAD);    
  114.         
  115.     if (! ISATOM(args[0]))
  116.         BIERROR(EBAD);
  117.  
  118.     for (i=0; i<MAXSTREAMS; i++)
  119.         if (!(streams[i].status & CLOSED)
  120.              && FUNC(args[0]) == FUNC(streams[i].atom)
  121.              && streams[i].status & OUTPUT)
  122.             break;
  123.     if (i == MAXSTREAMS)            /* new stream */
  124.     {
  125.         for (i=0; i<MAXSTREAMS && !(streams[i].status & CLOSED); i++);
  126.         if (i == MAXSTREAMS)        /* no slot left */
  127.             FILEERROR(EIO);        /* signal an error */
  128.         out = (stream *)(&(streams[i]));
  129.         out->atom = args[0];
  130.         if ((out->fp = fopen(NAME(args[0]), "w")) == NULL)
  131.             FILEERROR(EIO);
  132.         out->status = OUTPUT;
  133.     }
  134.     else
  135.     {
  136.         out = (stream *)(&(streams[i]));
  137.         if (ISFORINPUT(out) && FUNC(out->atom) != USERFUNCTOR)
  138.             FILEERROR(EIO);
  139.     }
  140.     return(TRUE);
  141. }
  142.  
  143. /*    TELLING(stream)    */
  144.  
  145. short bitelling(args)
  146. term *args[];
  147. {
  148.     if (ISVAR(args[0]))        /* must bind stream with out */
  149.     {
  150.         BIND_VAR(args[0], out->atom);
  151.         return(TRUE);
  152.     }
  153.     else
  154.     {
  155.         if (! ISATOM(args[0]))
  156.             BIERROR(EBAD);
  157.         return(FUNC(args[0]) == FUNC(out->atom));
  158.     }
  159. }
  160.  
  161. /*    TOLD    */
  162.  
  163. short bitold(/* args */)
  164. /* term *args[]; */
  165. {
  166.     if (ISCLOSED(out))        /* cannot close closed stream */
  167.         FILEERROR(EIO);
  168.         
  169.     if (FUNC(out->atom) == USERFUNCTOR)/* cannot close the user stream */
  170.         return(FALSE);
  171.     else
  172.     {
  173.         if (fclose(out->fp) <0)    /* error while closeing */
  174.             FILEERROR(EIO);
  175.         out->status = CLOSED;
  176.         out = (stream *)(&(streams[1]));
  177.     }
  178.     return(TRUE);
  179. }
  180.  
  181. /*    CLOSE(stream)    */
  182.  
  183. biclose(args)
  184. term *args[];
  185. {
  186.     if (! ISATOM(args[0]))
  187.         BIERROR(EBAD);
  188.         
  189.     if (FUNC(args[0]) == FUNC(in->atom))
  190.         return(biseen());
  191.     else
  192.         if (FUNC(args[0]) == FUNC(out->atom))
  193.             return(bitold());
  194.         else
  195.             FILEERROR(EIO);
  196. }
  197.  
  198. /*    FILEERRORS    */
  199.  
  200. short bifileerrors(/* args */)
  201. /* term *args[]; */
  202. {
  203.     io_errors = 1;
  204.     return(TRUE);
  205. }
  206.  
  207. /*    NOFILERRORS    */
  208.  
  209. short binofileerrors(/* args */)
  210. /* term *args[]; */
  211. {
  212.     io_errors = 0;
  213.     return(TRUE);
  214. }
  215.  
  216. /*    EXISTS(stream)    */
  217.  
  218. short biexists(args)
  219. term *args[];
  220. {
  221.     if (! ISATOM(args[0]))
  222.         BIERROR(EBAD);
  223.         
  224.     return(!access(NAME(args[0]), 0));
  225. }
  226.  
  227. /*    RENAME(old, new) */
  228.  
  229. short birename(args)
  230. term *args[];
  231. {
  232.     term *old;
  233.     term *new;
  234.     char string[255];
  235.     
  236.     old = args[0];
  237.     new = args[1];
  238.  
  239.     if (! ISATOM(old) || ! ISATOM(new))
  240.         BIERROR(EBAD);
  241.             
  242.     if (FUNC(new) == NILFUNCTOR)
  243.     {
  244.         if (unlink(NAME(old)) < 0)
  245.             FILEERROR(EIO);
  246.         return(TRUE);
  247.     }
  248.     sprintf(string, "mv %s %s", NAME(old), NAME(new));
  249.     if (system(string))
  250.         FILEERROR(EIO);
  251.     return(TRUE);
  252. }
  253.  
  254. /*    NL    */
  255.  
  256. short binl( /* args */ )
  257. /* term *args[]; */
  258. {
  259.     putc('\n', out->fp);
  260.     return(TRUE);
  261. }
  262.  
  263. /*    GET0( ORD )    */
  264.     
  265. short biget0(args)
  266. term *args[];
  267. {
  268.     term *t;
  269.     
  270.     if (! ISVAR(args[0]) && ! ISINT(args[0]))
  271.         BIERROR(EBAD);
  272.  
  273.     if (ISATEOF(in))        /* already at the end-of-file */
  274.         FILEERROR(EEOF);
  275.  
  276.     if ((lastc = getc(in->fp)) == EOF)     /* at EOF */
  277.     {
  278.         in->status |= SEOF;
  279.         t = EOFATOM;
  280.     }
  281.     else
  282.         t = int_copy((long)lastc);
  283.  
  284.     if (ISVAR(args[0]))
  285.     {
  286.         BIND_VAR(args[0], t);
  287.         return(TRUE);
  288.     }
  289.     else
  290.         return(VALUE(args[0]) == VALUE(t));
  291. }
  292.  
  293. /*    GET( ORD )    */
  294.     
  295. short biget(args)
  296. term *args[];
  297. {
  298.     term *t;
  299.     
  300.     if (! ISVAR(args[0]) && ! ISINT(args[0]))
  301.         BIERROR(EBAD);
  302.  
  303.     if (ISATEOF(in))        /* already at the end-of-file */
  304.         FILEERROR(EEOF);
  305.  
  306.     while ((lastc = getc(in->fp)) != EOF && lastc < ' ');
  307.     if (lastc  == EOF)            /* at EOF */
  308.     {
  309.         in->status |= SEOF;
  310.         t = EOFATOM;
  311.     }
  312.     else
  313.         t = int_copy((long)lastc);
  314.  
  315.     if (ISVAR(args[0]))
  316.     {
  317.         BIND_VAR(args[0], t);
  318.         return(TRUE);
  319.     }
  320.     else
  321.         return(VALUE(args[0]) == VALUE(t));
  322. }
  323.  
  324. /*    SKIP ( ORD )    */
  325.  
  326. short biskip(args)
  327. term *args[];
  328. {
  329.     char c;
  330.     
  331.     if (! ISINT(args[0]))        /* not proper argument */
  332.         BIERROR(EBAD);
  333.  
  334.     if (ISATEOF(in))        /* already at the end-of-file */
  335.         FILEERROR(EEOF);
  336.  
  337.     while ((c = getc(in->fp)) != EOF && c != (char)VALUE(args[0]));
  338.     if (c  == EOF)            /* at EOF */
  339.     {
  340.         in->status |= SEOF;
  341.         return(FALSE);
  342.     }
  343.     return(TRUE);
  344. }
  345.  
  346. /*    PUT (ord)    */
  347.  
  348. short biput(args)
  349. term *args[];
  350. {
  351.     short l;
  352.     
  353.     l = (short)eval(args[0]);
  354.     if (c_errno)
  355.         return(FALSE);
  356.     putc(l, out->fp);
  357.     return(TRUE);
  358. }
  359.  
  360. /*    TAB (ord)    */
  361.  
  362. short bitab(args)
  363. term *args[];
  364. {
  365.     short i;
  366.     
  367.     i = (short)eval(args[0]);
  368.     if (c_errno)
  369.         return(FALSE);
  370.         
  371.     while (i--)
  372.         putc(' ', out->fp);
  373.     return(TRUE);
  374. }
  375.  
  376. /*    OP ( prio, operator, name)    */
  377.  
  378. short biop(args)
  379. term *args[];
  380. {
  381.     unsigned short pre;
  382.     
  383.     if (!ISINT(args[0]))
  384.         BIERROR(EBAD);
  385.     if (!ISATOM(args[1]) || !ISATOM(args[2]))
  386.         BIERROR(EBAD);
  387.         
  388.     pre = (unsigned short)VALUE(args[0]);
  389.     if (pre < 0 || pre > 255)    /* preceedence out of range */
  390.         return(FALSE);
  391.     add_operator(NAME(args[2]), FUNC(args[1]), pre);
  392.     return(TRUE);
  393. }
  394.  
  395. /*    READ ( term ) */
  396.  
  397. short biread(args)
  398. term *args[];
  399. {
  400.     term *t;
  401.  
  402.     if (FUNC(in->atom) == USERFUNCTOR)
  403.     {
  404.         clearerr(in->fp);
  405.         in->status = INPUT;    /* clear errors */
  406.     }
  407.     
  408.     if (ISATEOF(in))        /* already at the end-of-file */
  409.         FILEERROR(EEOF);
  410.  
  411.     t = read_term();        /* read it */
  412.     if (c_errno == EEOF)        /* we reached EOF */
  413.     {
  414.         t = EOFATOM;
  415.         c_errno = 0;        /* reset the error */
  416.     }
  417.     if (!t || c_errno)        /* something strange */
  418.         return(FALSE);
  419.  
  420.     return(term_unify(args[0], Topenv, t, Topenv));
  421. }
  422.  
  423. /*    WRITE ( term )    */
  424.  
  425. short biwrite(args)
  426. term *args[];
  427. {
  428.     display(args[0], Topenv, 255, TRUE, FALSE);
  429.     return(TRUE);
  430. }
  431.  
  432. /*    WRITEQ ( term )    */
  433.  
  434. short biwriteq(args)
  435. term *args[];
  436. {
  437.     display(args[0], Topenv, 255, TRUE, TRUE);
  438.     return(TRUE);
  439. }
  440.  
  441. /*    DISPLAY ( term ) */
  442.  
  443. short bidisplay(args)
  444. term *args[];
  445. {
  446.     display(args[0], Topenv, 255, FALSE, FALSE);
  447.     return(TRUE);
  448. }
  449.