1 /* -*-C-*- 2 3 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 4 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 5 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014 Massachusetts 6 Institute of Technology 7 8 This file is part of MIT/GNU Scheme. 9 10 MIT/GNU Scheme is free software; you can redistribute it and/or modify 11 it under the terms of the GNU General Public License as published by 12 the Free Software Foundation; either version 2 of the License, or (at 13 your option) any later version. 14 15 MIT/GNU Scheme is distributed in the hope that it will be useful, but 16 WITHOUT ANY WARRANTY; without even the implied warranty of 17 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 18 General Public License for more details. 19 20 You should have received a copy of the GNU General Public License 21 along with MIT/GNU Scheme; if not, write to the Free Software 22 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, 23 USA. 24 25 */ 26 27 /* Primitives to perform I/O to and from files. */ 28 29 #include "scheme.h" 30 #include "prims.h" 31 #include "osfile.h" 32 33 extern Tchannel arg_channel (int); 34 35 #ifndef OPEN_FILE_HOOK 36 #define OPEN_FILE_HOOK(channel) 37 #endif 38 39 #define NEW_OPEN_FILE_PRIMITIVE(OS_open_file) \ 40 { \ 41 PRIMITIVE_HEADER (2); \ 42 CHECK_ARG (2, WEAK_PAIR_P); \ 43 { \ 44 Tchannel channel = (OS_open_file (STRING_ARG (1))); \ 45 OPEN_FILE_HOOK (channel); \ 46 SET_PAIR_CDR ((ARG_REF (2)), (long_to_integer (channel))); \ 47 PRIMITIVE_RETURN (SHARP_T); \ 48 } \ 49 } 50 51 DEFINE_PRIMITIVE ("NEW-FILE-OPEN-INPUT-CHANNEL", 52 Prim_new_file_open_input_channel, 2, 2, 53 "Open an input file called FILENAME.\n\ 54 The channel number is saved in the cdr of WEAK-PAIR.") NEW_OPEN_FILE_PRIMITIVE(OS_open_input_file)55 NEW_OPEN_FILE_PRIMITIVE (OS_open_input_file) 56 57 DEFINE_PRIMITIVE ("NEW-FILE-OPEN-OUTPUT-CHANNEL", 58 Prim_new_file_open_output_channel, 2, 2, 59 "Open an output file called FILENAME.\n\ 60 The channel number is saved in the cdr of WEAK-PAIR.\n\ 61 If the file exists, it is rewritten.") 62 NEW_OPEN_FILE_PRIMITIVE (OS_open_output_file) 63 64 /* Really this should just return #F or something, I think, since the 65 possibility of the file's existence is so common a case to worry 66 about. Doing so requires more changes to the runtime, though. */ 67 68 DEFINE_PRIMITIVE ("NEW-FILE-OPEN-EXCLUSIVE-OUTPUT-CHANNEL", 69 Prim_new_file_open_exclusive_output_channel, 2, 2, 70 "Open an output file called FILENAME.\n\ 71 The channel number is saved in the cdr of WEAK-PAIR.\n\ 72 If the file exists, an error is signalled.") 73 NEW_OPEN_FILE_PRIMITIVE (OS_open_exclusive_output_file) 74 75 DEFINE_PRIMITIVE ("NEW-FILE-OPEN-IO-CHANNEL", Prim_new_file_open_io_channel, 76 2, 2, 77 "Open a file called FILENAME.\n\ 78 The channel number is saved in the cdr of WEAK-PAIR.\n\ 79 The file is opened for both input and output.\n\ 80 If the file exists, its contents are not disturbed.") 81 NEW_OPEN_FILE_PRIMITIVE (OS_open_io_file) 82 83 DEFINE_PRIMITIVE ("NEW-FILE-OPEN-APPEND-CHANNEL", 84 Prim_new_file_open_append_channel, 2, 2, 85 "Open an output file called FILENAME.\n\ 86 The channel number is saved in the cdr of WEAK-PAIR.\n\ 87 If the file exists, output is appended to its contents.") 88 NEW_OPEN_FILE_PRIMITIVE (OS_open_append_file) 89 90 #define OPEN_FILE_PRIMITIVE(OS_open_file) \ 91 { \ 92 PRIMITIVE_HEADER (1); \ 93 { \ 94 Tchannel channel = (OS_open_file (STRING_ARG (1))); \ 95 OPEN_FILE_HOOK (channel); \ 96 PRIMITIVE_RETURN (long_to_integer (channel)); \ 97 } \ 98 } 99 100 DEFINE_PRIMITIVE ("FILE-OPEN-INPUT-CHANNEL", Prim_file_open_input_channel, 101 1, 1, 102 "Open an input file called FILENAME, returning a channel number.") 103 OPEN_FILE_PRIMITIVE (OS_open_input_file) 104 105 DEFINE_PRIMITIVE ("FILE-OPEN-OUTPUT-CHANNEL", Prim_file_open_output_channel, 106 1, 1, 107 "Open an output file called FILENAME, returning a channel number.\n\ 108 If the file exists, it is rewritten.") 109 OPEN_FILE_PRIMITIVE (OS_open_output_file) 110 111 DEFINE_PRIMITIVE ("FILE-OPEN-EXCLUSIVE-OUTPUT-CHANNEL", 112 Prim_file_open_exclusive_output_channel, 2, 2, 113 "Open an output file called FILENAME, returning a channel number.\n\ 114 If the file exists, an error is signalled.") 115 OPEN_FILE_PRIMITIVE (OS_open_exclusive_output_file) 116 117 DEFINE_PRIMITIVE ("FILE-OPEN-IO-CHANNEL", Prim_file_open_io_channel, 1, 1, 118 "Open a file called FILENAME, returning a channel number.\n\ 119 The file is opened for both input and output.\n\ 120 If the file exists, its contents are not disturbed.") 121 OPEN_FILE_PRIMITIVE (OS_open_io_file) 122 123 DEFINE_PRIMITIVE ("FILE-OPEN-APPEND-CHANNEL", Prim_file_open_append_channel, 124 1, 1, 125 "Open an output file called FILENAME, returning a channel number.\n\ 126 If the file exists, output is appended to its contents.") 127 OPEN_FILE_PRIMITIVE (OS_open_append_file) 128 129 DEFINE_PRIMITIVE ("FILE-LENGTH-NEW", Prim_file_length_new, 1, 1, 130 "Return the length of CHANNEL in characters.") 131 { 132 PRIMITIVE_HEADER (1); 133 PRIMITIVE_RETURN (intmax_to_integer (OS_file_length (arg_channel (1)))); 134 } 135 136 DEFINE_PRIMITIVE ("FILE-POSITION", Prim_file_position, 1, 1, 137 "Return the position of CHANNEL's file-pointer.\n\ 138 This is a non-negative number strictly less than the file's length.") 139 { 140 PRIMITIVE_HEADER (1); 141 PRIMITIVE_RETURN (intmax_to_integer (OS_file_position (arg_channel (1)))); 142 } 143 144 DEFINE_PRIMITIVE ("FILE-SET-POSITION", Prim_file_set_position, 2, 2, 145 "Set the file-pointer of CHANNEL to POSITION.\n\ 146 POSITION must be a non-negative number strictly less than the file's length.") 147 { 148 PRIMITIVE_HEADER (1); 149 OS_file_set_position 150 ((arg_channel (1)), (arg_index_integer_to_intmax (2, OFF_T_MAX))); 151 PRIMITIVE_RETURN (UNSPECIFIC); 152 } 153 154 DEFINE_PRIMITIVE ("FILE-TRUNCATE", Prim_file_truncate, 2, 2, 155 "Set the length of CHANNEL to LENGTH.\n\ 156 LENGTH must be a non-negative number.") 157 { 158 PRIMITIVE_HEADER (1); 159 OS_file_truncate 160 ((arg_channel (1)), (arg_index_integer_to_intmax (2, OFF_T_MAX))); 161 PRIMITIVE_RETURN (UNSPECIFIC); 162 } 163