home *** CD-ROM | disk | FTP | other *** search
/ rtsi.com / 2014.01.www.rtsi.com.tar / www.rtsi.com / OS9 / OSK / EFFO / pd3.lzh / SBPROLOG2.2 / SIM / BUILTIN / file.c < prev    next >
Text File  |  1991-08-10  |  9KB  |  398 lines
  1. /************************************************************************
  2. *                                    *
  3. *    The SB-Prolog System                        *
  4. *    Copyright SUNY at Stony Brook, 1986                *
  5. *                                    *
  6. ************************************************************************/
  7.  
  8. /*-----------------------------------------------------------------
  9. SB-Prolog is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY.  No author or distributor
  11. accepts responsibility to anyone for the consequences of using it
  12. or for whether it serves any particular purpose or works at all,
  13. unless he says so in writing.  Refer to the SB-Prolog General Public
  14. License for full details.
  15.  
  16. Everyone is granted permission to copy, modify and redistribute
  17. SB-Prolog, but only under the conditions described in the
  18. SB-Prolog General Public License.   A copy of this license is
  19. supposed to have been given to you along with SB-Prolog so you
  20. can know your rights and responsibilities.  It should be in a
  21. file named COPYING.  Among other things, the copyright notice
  22. and this notice must be preserved on all copies. 
  23. ------------------------------------------------------------------ */
  24.  
  25. /* file.c */
  26.  
  27. #include "builtin.h"
  28. #ifndef OS9
  29. #include <netdb.h>
  30. #include <stdio.h>
  31. #define PMODE 0644
  32. #endif
  33.  
  34. extern double floatval();
  35.  
  36. static int n, a, i;
  37. static int fileerrors = 0;    /* abort, or not on file errors */
  38. static struct psc_rec *user_psc, *ptr;
  39. static FILE *tempfile;
  40. static char s[256];
  41.  
  42. static word user_word, con_word;
  43.  
  44. struct ftab_ent {
  45.     int inout;        /* 1 if input, 0 if output */
  46.     word p_ptr;        /* tagged ptr to psc_ptr of constant */
  47.     FILE *fdes;        /* file descriptor for this constant */
  48.     };
  49.  
  50.     /* table of open files; 0 is always stdin, 1 is always stdout */
  51. static struct ftab_ent file_table[20];
  52. static int file_tab_end = 0;    /* last used entry in file_table */
  53.  
  54.     /* index of current input (output) stream in file_table */
  55. static int in_file_i, out_file_i;
  56.  
  57. static struct hostent *hp;
  58.  
  59.  
  60. int get_file_index(cword, io)
  61. word cword;
  62. int io;
  63. {
  64.     for (i=0; i<=file_tab_end; i++) {
  65.         if (file_table[i].p_ptr == cword)
  66.             if (io == file_table[i].inout || io >1) return(i);
  67.     }
  68.     return (-1);
  69. }
  70.  
  71. b_FILEERRORS()
  72. {
  73.     fileerrors = 1;
  74. }
  75.  
  76. b_NOFILEERRORS()
  77. {
  78.     fileerrors = 0;
  79. }
  80.  
  81. b_PUT() /* (N) */
  82. {
  83.     register word op; register pw top;
  84.  
  85.     op = gregc(1); deref(op);
  86.     if (!isinteger(op)) {Fail0;}
  87.     else putc(intval(op), file_table[out_file_i].fdes);
  88.     fflush(file_table[out_file_i].fdes);
  89. }
  90.  
  91. b_GET0() /* (N) */
  92. {
  93.     register word op; register pw top;
  94.  
  95.     n = getc(file_table[in_file_i].fdes);
  96.     if (n == EOF)
  97.     {
  98.         clearerr(file_table[in_file_i].fdes);
  99.         cleareof(file_table[in_file_i].fdes);
  100.     }
  101.     op = gregc(1); deref(op);
  102.     if (isnonvar(op)) {if (!unify(op,makeint(n))) {Fail0;}}
  103.     else {follow(op) = makeint(n); pushtrail(op);}
  104. }
  105.  
  106. b_GET() /* (N) */
  107. {
  108.     register word op; register pw top;
  109.  
  110.     do n = getc(file_table[in_file_i].fdes);
  111.     while (n!= EOF && n < 16 && n >= 112);
  112.     if (n == EOF) {
  113.         clearerr(file_table[in_file_i].fdes);
  114.         cleareof(file_table[in_file_i].fdes);
  115.         Fail0; return;
  116.         }
  117.     op = gregc(1); deref(op);
  118.     if (isnonvar(op)) {if (!unify(op,makeint(n))) {Fail0;}}
  119.     else {follow(op) = makeint(n); pushtrail(op);}
  120. }
  121.  
  122. b_SKIP()
  123. { /* (N) */
  124.     register word op; register pw top;
  125.  
  126.     op = gregc(1); deref(op);
  127.     if (!isinteger(op)) {Fail0; return;}
  128.     a = intval(op);
  129.     if (a < 16 || a >= 112) {Fail0;}
  130.     else {
  131.         do n = getc(file_table[in_file_i].fdes);
  132.         while (n != EOF && n != a);
  133.         if (n = EOF) {
  134.             clearerr(file_table[in_file_i].fdes);
  135.             cleareof(file_table[in_file_i].fdes);
  136.             if (fileerrors) quit("end of file encountered.\n");
  137.             else {Fail0;}
  138.             }
  139.         }
  140. }
  141.  
  142. b_TAB()
  143. { /* (N) */
  144.     register word op; register pw top;
  145.  
  146.     op = gregc(1); deref(op);
  147.     if (!isinteger(op)) {Fail0; return;}
  148.     a = intval(op);
  149.     if (a < 0) {Fail0; return;}
  150.     for ( ; a>0; a--) putc(' ', file_table[out_file_i].fdes);
  151.     fflush(file_table[out_file_i].fdes);
  152. }
  153.  
  154. b_NL()
  155. { /* () */
  156.     putc('\n', file_table[out_file_i].fdes);
  157.     fflush(file_table[out_file_i].fdes);
  158. }
  159.  
  160. b_WRITENAME()
  161. { /* (X) */
  162.     register word op; register pw top;
  163.  
  164.     op = gregc(1);
  165.     wnd: switch ((int)(op&3)) {
  166.         case FREE:
  167.             nderef(op, wnd);
  168.             fprintf(file_table[out_file_i].fdes, "_%d", untagged(op));
  169.             break;
  170.         case LIST:
  171.             fprintf(file_table[out_file_i].fdes, ".");
  172.             break;
  173.         case CS:
  174.             ptr = get_str_psc(op);
  175.             writepname(file_table[out_file_i].fdes,
  176.                 get_name(ptr), get_length(ptr));
  177.             break;
  178.         case NUM:
  179.             if (isinteger(op))
  180.                 fprintf(file_table[out_file_i].fdes, "%d", intval(op));
  181.             else fprintf(file_table[out_file_i].fdes, "%f", floatval(op));
  182.             break;
  183.     }
  184.     fflush(file_table[out_file_i].fdes);
  185. }
  186.  
  187. b_WRITEQNAME()
  188. { /* (X) */
  189.     register word op; register pw top;
  190.  
  191.     op = gregc(1);
  192.     wnd: switch ((int)(op&3)) {
  193.         case FREE:
  194.             nderef(op, wnd);
  195.             fprintf(file_table[out_file_i].fdes, "_%d", untagged(op));
  196.             break;
  197.         case LIST:
  198.             fprintf(file_table[out_file_i].fdes, ".");
  199.             break;
  200.         case CS:
  201.             ptr = get_str_psc(op);
  202.             writeqname(file_table[out_file_i].fdes,
  203.                 get_name(ptr), get_length(ptr));
  204.             break;
  205.         case NUM:
  206.             if (isinteger(op))
  207.                 fprintf(file_table[out_file_i].fdes, "%d", intval(op));
  208.             else fprintf(file_table[out_file_i].fdes, "%f", floatval(op));
  209.             break;
  210.     }
  211.     fflush(file_table[out_file_i].fdes);
  212. }
  213.  
  214. b_RESET() /* () */
  215. {
  216.     quit("RESET not implemented\n");
  217. /*    fop = gregc(1);
  218.     get_file_psc();
  219.     if (p == user_psc) set_file_ptr(p, stdin);
  220.     else {
  221.         namestring(p, s);
  222.         set_file_ptr(p, fopen(s, "r"));
  223.         if (get_file_ptr(p) == 0) {Fail0;}
  224.     } */
  225. }
  226.  
  227. b_REWRITE() /* () */
  228. {
  229.     quit("REWRITE not implemented\n");
  230. /*    fop = gregc(1);
  231.     get_file_psc();
  232.     if (p == user_psc) set_file_ptr(p, stdout);
  233.     else {
  234.         namestring(p, s);
  235.         set_file_ptr(p, fopen(s, "w"));
  236.         if (get_file_ptr(p) == 0) {Fail0;}
  237.     } */
  238. }
  239.  
  240. b_CLOSE()
  241. {
  242.     register word fop; register pw top;
  243.  
  244.     fop = gregc(1); deref(fop);
  245.     i = get_file_index(fop, 2);
  246.     if (i>1) { /* not user */
  247.         fclose(file_table[i].fdes);
  248.         for ( ; i<file_tab_end; i++) {
  249. #ifndef OS9
  250.             file_table[i] = file_table[i+1];
  251. #else
  252.             _strass(file_table+i,file_table+i+1,sizeof(struct ftab_ent));
  253. #endif
  254.         }
  255.         file_tab_end--;
  256.     }
  257. }
  258.  
  259. b_SEE() /* r1: file name */
  260. {
  261.     register word fop; register pw top;
  262.     int temp_in_file_i;
  263.  
  264.     fop = gregc(1); deref(fop);
  265.     temp_in_file_i = get_file_index(fop, 1);
  266.     if (temp_in_file_i<0) { /* not in table */
  267.         namestring(get_str_psc(fop), s);
  268.         tempfile = fopen(s ,"r");
  269.         if (!tempfile) {Fail0; return; } /* leaving in_file_i unchanged */
  270.         in_file_i = ++ file_tab_end;
  271.         file_table[in_file_i].inout = 1;
  272.         file_table[in_file_i].p_ptr = fop;
  273.         file_table[in_file_i].fdes = tempfile;
  274.     }
  275.     else in_file_i = temp_in_file_i; /* take it from table */
  276. }
  277.  
  278. b_TELL() /* r1: file name */
  279.          /* r2: 0 -> open `w'-write; 1 -> open `a'-append */
  280. {
  281.     register word sop, fop; register pw top;
  282.  
  283.     fop = gregc(1); deref(fop);
  284.     sop = gregc(2); deref(sop);
  285.     out_file_i = get_file_index(fop, 0);
  286.     if (out_file_i<0) { /* not in table */
  287.         namestring(get_str_psc(fop), s);
  288.         if (intval(sop)) tempfile = fopen(s, "a");
  289.         else tempfile = fopen(s ,"w");
  290.         if (!tempfile) {Fail0; return; }
  291.         out_file_i = ++ file_tab_end;
  292.         file_table[out_file_i].inout = 0;
  293.         file_table[out_file_i].p_ptr = fop;
  294.         file_table[out_file_i].fdes = tempfile;
  295.     }
  296. }
  297.  
  298. b_SEEING() /* r1: unified with the current input file name */
  299. {
  300.     if (!unify(gregc(1), file_table[in_file_i].p_ptr)) {Fail0;}
  301. }
  302.  
  303. b_TELLING() /* r1: unified with the current output file name */
  304. {
  305.     if (!unify(gregc(1), file_table[out_file_i].p_ptr)) {Fail0;}
  306. }
  307.  
  308. b_SEEN()
  309. {
  310.     if (in_file_i > 1) {
  311.         fclose(file_table[in_file_i].fdes);
  312.         for( ; in_file_i<file_tab_end; in_file_i++) {
  313. #ifndef OS9
  314.             file_table[in_file_i] = file_table[in_file_i+1];
  315. #else
  316.             _strass(file_table+in_file_i,file_table+in_file_i+1,
  317.                     sizeof(struct ftab_ent));
  318. #endif
  319.         }
  320.         file_tab_end--;
  321.     }
  322.     in_file_i = 0; /* reset to user */
  323. }
  324.  
  325. b_TOLD()
  326. {
  327.     if (out_file_i > 1) {
  328.         fclose(file_table[out_file_i].fdes);
  329.         for( ; out_file_i<file_tab_end; out_file_i++) {
  330. #ifndef OS9
  331.             file_table[out_file_i] = file_table[out_file_i+1];
  332. #else
  333.             _strass(file_table+out_file_i,file_table+out_file_i+1,
  334.                     sizeof(struct ftab_ent));
  335. #endif
  336.         }
  337.         file_tab_end--;
  338.     }
  339.     out_file_i = 1; /* reset to user */
  340. }
  341.  
  342. b_GETHOSTBYNAME() /* r1 is a constant indicating the host name,
  343.                      r2 is a namebuffer (of length 16) returned */
  344. {
  345. #ifndef OS9
  346.     register word op1, op2; register pw top;
  347.  
  348.     op1 = gregc(1); deref(op1);
  349.     op2 = gregc(2); deref(op2);
  350.     namestring(get_str_psc(op1), s);
  351.     hp = gethostbyname(s);
  352.     bcopy(hp->h_addr, get_name(get_str_psc(op2))+4, hp->h_length);
  353. #else
  354.     quit("GETHOSTBYNAME not implemented");
  355. #endif
  356. }
  357.  
  358. file_init()
  359. {
  360.     word temp;
  361.     char perm =1;
  362.     char arity = 0;
  363.  
  364.     temp = insert("user", 4, arity, &perm);
  365.     user_psc = (struct psc_rec *)(follow(temp));
  366.     user_word = temp | CS_TAG;
  367.  
  368.     file_table[0].inout = 1;
  369.     file_table[0].p_ptr = user_word;
  370.     file_table[0].fdes = stdin;
  371.     in_file_i = 0;
  372.  
  373.     file_table[1].inout = 0;
  374.     file_table[1].p_ptr = user_word;
  375.     file_table[1].fdes = stdout;
  376.     out_file_i = 1;
  377.  
  378.     file_tab_end = 1;
  379. }
  380.  
  381. b_WRITE4()
  382. {    /* register 1 contains a bit string that is written out in 4 bytes */
  383.     register word op, wbyte;
  384.     register pw top;
  385.     int i;
  386.  
  387.     op = gregc(1); deref(op);
  388.     for (i = 1; i <= 4; i++)
  389.     {    wbyte = ((op & 0xff000000)>>24);
  390.         op = op << 8;
  391.         putc(wbyte, file_table[out_file_i].fdes);
  392.     }
  393.     return;
  394. }
  395.  
  396.  
  397.  
  398.