home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / mitsch75.zip / scheme-7_5_17-src.zip / scheme-7.5.17 / src / microcode / prosfile.c < prev    next >
C/C++ Source or Header  |  1999-01-02  |  5KB  |  123 lines
  1. /* -*-C-*-
  2.  
  3. $Id: prosfile.c,v 1.9 1999/01/02 06:11:34 cph Exp $
  4.  
  5. Copyright (c) 1987-1999 Massachusetts Institute of Technology
  6.  
  7. This program is free software; you can redistribute it and/or modify
  8. it under the terms of the GNU General Public License as published by
  9. the Free Software Foundation; either version 2 of the License, or (at
  10. your option) any later version.
  11.  
  12. This program is distributed in the hope that it will be useful, but
  13. WITHOUT ANY WARRANTY; without even the implied warranty of
  14. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15. General Public License for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with this program; if not, write to the Free Software
  19. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20. */
  21.  
  22. /* Primitives to perform I/O to and from files. */
  23.  
  24. #include "scheme.h"
  25. #include "prims.h"
  26. #include "osfile.h"
  27.  
  28. extern Tchannel EXFUN (arg_channel, (int));
  29.  
  30. #ifndef OPEN_FILE_HOOK
  31. #define OPEN_FILE_HOOK(channel)
  32. #endif
  33.  
  34. #define NEW_OPEN_FILE_PRIMITIVE(OS_open_file)                \
  35. {                                    \
  36.   PRIMITIVE_HEADER (2);                            \
  37.   CHECK_ARG (2, WEAK_PAIR_P);                        \
  38.   {                                    \
  39.     Tchannel channel = (OS_open_file (STRING_ARG (1)));            \
  40.     OPEN_FILE_HOOK (channel);                        \
  41.     SET_PAIR_CDR ((ARG_REF (2)), (long_to_integer (channel)));        \
  42.     PRIMITIVE_RETURN (SHARP_T);                        \
  43.   }                                    \
  44. }
  45.  
  46. DEFINE_PRIMITIVE ("NEW-FILE-OPEN-INPUT-CHANNEL", Prim_new_file_open_input_channel, 2, 2,
  47.   "Open an input file called FILENAME.\n\
  48. The channel number is saved in the cdr of WEAK-PAIR.")
  49.   NEW_OPEN_FILE_PRIMITIVE (OS_open_input_file)
  50.  
  51. DEFINE_PRIMITIVE ("NEW-FILE-OPEN-OUTPUT-CHANNEL", Prim_new_file_open_output_channel, 2, 2,
  52.   "Open an output file called FILENAME.\n\
  53. The channel number is saved in the cdr of WEAK-PAIR.\n\
  54. If the file exists, it is rewritten.")
  55.   NEW_OPEN_FILE_PRIMITIVE (OS_open_output_file)
  56.  
  57. DEFINE_PRIMITIVE ("NEW-FILE-OPEN-IO-CHANNEL", Prim_new_file_open_io_channel, 2, 2,
  58.   "Open a file called FILENAME.\n\
  59. The channel number is saved in the cdr of WEAK-PAIR.\n\
  60. The file is opened for both input and output.\n\
  61. If the file exists, its contents are not disturbed.")
  62.   NEW_OPEN_FILE_PRIMITIVE (OS_open_io_file)
  63.  
  64. DEFINE_PRIMITIVE ("NEW-FILE-OPEN-APPEND-CHANNEL", Prim_new_file_open_append_channel, 2, 2,
  65.   "Open an output file called FILENAME.\n\
  66. The channel number is saved in the cdr of WEAK-PAIR.\n\
  67. If the file exists, output is appended to its contents.")
  68.   NEW_OPEN_FILE_PRIMITIVE (OS_open_append_file)
  69.  
  70. #define OPEN_FILE_PRIMITIVE(OS_open_file)                \
  71. {                                    \
  72.   PRIMITIVE_HEADER (1);                            \
  73.   {                                    \
  74.     Tchannel channel = (OS_open_file (STRING_ARG (1)));            \
  75.     OPEN_FILE_HOOK (channel);                        \
  76.     PRIMITIVE_RETURN (long_to_integer (channel));            \
  77.   }                                    \
  78. }
  79.  
  80. DEFINE_PRIMITIVE ("FILE-OPEN-INPUT-CHANNEL", Prim_file_open_input_channel, 1, 1,
  81.   "Open an input file called FILENAME, returning a channel number.")
  82.   OPEN_FILE_PRIMITIVE (OS_open_input_file)
  83.  
  84. DEFINE_PRIMITIVE ("FILE-OPEN-OUTPUT-CHANNEL", Prim_file_open_output_channel, 1, 1,
  85.   "Open an output file called FILENAME, returning a channel number.\n\
  86. If the file exists, it is rewritten.")
  87.   OPEN_FILE_PRIMITIVE (OS_open_output_file)
  88.  
  89. DEFINE_PRIMITIVE ("FILE-OPEN-IO-CHANNEL", Prim_file_open_io_channel, 1, 1,
  90.   "Open a file called FILENAME, returning a channel number.\n\
  91. The file is opened for both input and output.\n\
  92. If the file exists, its contents are not disturbed.")
  93.   OPEN_FILE_PRIMITIVE (OS_open_io_file)
  94.  
  95. DEFINE_PRIMITIVE ("FILE-OPEN-APPEND-CHANNEL", Prim_file_open_append_channel, 1, 1,
  96.   "Open an output file called FILENAME, returning a channel number.\n\
  97. If the file exists, output is appended to its contents.")
  98.   OPEN_FILE_PRIMITIVE (OS_open_append_file)
  99.  
  100. DEFINE_PRIMITIVE ("FILE-LENGTH-NEW", Prim_file_length_new, 1, 1,
  101.   "Return the length of CHANNEL in characters.")
  102. {
  103.   PRIMITIVE_HEADER (1);
  104.   PRIMITIVE_RETURN (long_to_integer (OS_file_length (arg_channel (1))));
  105. }
  106.  
  107. DEFINE_PRIMITIVE ("FILE-POSITION", Prim_file_position, 1, 1,
  108.   "Return the position of CHANNEL's file-pointer.\n\
  109. This is a non-negative number strictly less than the file's length.")
  110. {
  111.   PRIMITIVE_HEADER (1);
  112.   PRIMITIVE_RETURN (long_to_integer (OS_file_position (arg_channel (1))));
  113. }
  114.  
  115. DEFINE_PRIMITIVE ("FILE-SET-POSITION", Prim_file_set_position, 2, 2,
  116.   "Set the file-pointer of CHANNEL to POSITION.\n\
  117. POSITION must be a non-negative number strictly less than the file's length.")
  118. {
  119.   PRIMITIVE_HEADER (1);
  120.   OS_file_set_position ((arg_channel (1)), (arg_nonnegative_integer (2)));
  121.   PRIMITIVE_RETURN (UNSPECIFIC);
  122. }
  123.