1 /********************************************************************/
2 /* */
3 /* s7 Seed7 interpreter */
4 /* Copyright (C) 1990 - 2018 Thomas Mertes */
5 /* */
6 /* This program is free software; you can redistribute it and/or */
7 /* modify it under the terms of the GNU General Public License as */
8 /* published by the Free Software Foundation; either version 2 of */
9 /* the License, or (at your option) any later version. */
10 /* */
11 /* This program is distributed in the hope that it will be useful, */
12 /* but WITHOUT ANY WARRANTY; without even the implied warranty of */
13 /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
14 /* GNU General Public License for more details. */
15 /* */
16 /* You should have received a copy of the GNU General Public */
17 /* License along with this program; if not, write to the */
18 /* Free Software Foundation, Inc., 51 Franklin Street, */
19 /* Fifth Floor, Boston, MA 02110-1301, USA. */
20 /* */
21 /* Module: Library */
22 /* File: seed7/src/fillib.c */
23 /* Changes: 1992, 1993, 1994, 2013 - 2016 Thomas Mertes */
24 /* Content: All primitive actions for the primitive file type. */
25 /* */
26 /********************************************************************/
27
28 #define LOG_FUNCTIONS 0
29 #define VERBOSE_EXCEPTIONS 0
30
31 #include "version.h"
32
33 #include "stdlib.h"
34 #include "stdio.h"
35 #include "sys/types.h"
36
37 #include "common.h"
38 #include "data.h"
39 #include "os_decls.h"
40 #include "heaputl.h"
41 #include "syvarutl.h"
42 #include "striutl.h"
43 #include "objutl.h"
44 #include "runerr.h"
45 #include "fil_rtl.h"
46 #include "fil_drv.h"
47
48 #undef EXTERN
49 #define EXTERN
50 #include "fillib.h"
51
52
53 #ifndef SEEK_SET
54 #define SEEK_SET 0
55 #endif
56
57 #ifndef SEEK_CUR
58 #define SEEK_CUR 1
59 #endif
60
61 #ifndef SEEK_END
62 #define SEEK_END 2
63 #endif
64
65
66
67 /**
68 * Determine the size of a file and return it as bigInteger.
69 * The file length is measured in bytes.
70 * @return the size of the given file.
71 * @exception FILE_ERROR A system function returns an error or the
72 * file length reported by the system is negative.
73 * @exception MEMORY_ERROR Not enough memory to represent the result.
74 */
fil_big_lng(listType arguments)75 objectType fil_big_lng (listType arguments)
76
77 { /* fil_big_lng */
78 isit_file(arg_1(arguments));
79 return bld_bigint_temp(
80 filBigLng(take_file(arg_1(arguments))));
81 } /* fil_big_lng */
82
83
84
85 /**
86 * Set the current file position.
87 * The file position is measured in bytes from the start of the file.
88 * The first byte in the file has the position 1.
89 * @exception RANGE_ERROR The file position is negative or zero or
90 * the file position is not representable in the system
91 * file position type.
92 * @exception FILE_ERROR A system function returns an error.
93 */
fil_big_seek(listType arguments)94 objectType fil_big_seek (listType arguments)
95
96 { /* fil_big_seek */
97 isit_file(arg_1(arguments));
98 isit_bigint(arg_2(arguments));
99 filBigSeek(take_file(arg_1(arguments)),
100 take_bigint(arg_2(arguments)));
101 return SYS_EMPTY_OBJECT;
102 } /* fil_big_seek */
103
104
105
106 /**
107 * Obtain the current file position.
108 * The file position is measured in bytes from the start of the file.
109 * The first byte in the file has the position 1.
110 * @return the current file position.
111 * @exception FILE_ERROR A system function returns an error or the
112 * file position reported by the system is negative.
113 * @exception MEMORY_ERROR Not enough memory to represent the result.
114 */
fil_big_tell(listType arguments)115 objectType fil_big_tell (listType arguments)
116
117 { /* fil_big_tell */
118 isit_file(arg_1(arguments));
119 return bld_bigint_temp(
120 filBigTell(take_file(arg_1(arguments))));
121 } /* fil_big_tell */
122
123
124
125 /**
126 * Close a clib_file.
127 * @exception FILE_ERROR A system function returns an error.
128 */
fil_close(listType arguments)129 objectType fil_close (listType arguments)
130
131 { /* fil_close */
132 isit_file(arg_1(arguments));
133 filClose(take_file(arg_1(arguments)));
134 return SYS_EMPTY_OBJECT;
135 } /* fil_close */
136
137
138
139 /**
140 * Assign source/arg_3 to dest/arg_1.
141 * A copy function assumes that dest/arg_1 contains a legal value.
142 */
fil_cpy(listType arguments)143 objectType fil_cpy (listType arguments)
144
145 {
146 objectType dest;
147 objectType source;
148 fileType fileSource;
149 fileType oldFile;
150
151 /* fil_cpy */
152 dest = arg_1(arguments);
153 source = arg_3(arguments);
154 isit_file(dest);
155 isit_file(source);
156 is_variable(dest);
157 fileSource = take_file(source);
158 oldFile = take_file(dest);
159 logFunction(printf("fil_cpy(" FMT_U_MEM " %s%d (usage=" FMT_U "), "
160 FMT_U_MEM " %s%d (usage=" FMT_U "))\n",
161 (memSizeType) oldFile,
162 oldFile == NULL ? "NULL " : "",
163 oldFile != NULL ? safe_fileno(oldFile->cFile) : 0,
164 oldFile != NULL ? oldFile->usage_count : (uintType) 0,
165 (memSizeType) fileSource,
166 fileSource == NULL ? "NULL " : "",
167 fileSource != NULL ? safe_fileno(fileSource->cFile) : 0,
168 fileSource != NULL ? fileSource->usage_count : (uintType) 0););
169 if (TEMP_OBJECT(source)) {
170 source->value.fileValue = NULL;
171 } else {
172 if (fileSource != NULL && fileSource->usage_count != 0) {
173 fileSource->usage_count++;
174 } /* if */
175 } /* if */
176 if (oldFile != NULL && oldFile->usage_count != 0) {
177 oldFile->usage_count--;
178 if (oldFile->usage_count == 0) {
179 filFree(oldFile);
180 } /* if */
181 } /* if */
182 dest->value.fileValue = fileSource;
183 logFunction(printf("fil_cpy(" FMT_U_MEM " %s%d (usage=" FMT_U "), "
184 FMT_U_MEM " %s%d (usage=" FMT_U ")) -->\n",
185 (memSizeType) fileSource,
186 fileSource == NULL ? "NULL " : "",
187 fileSource != NULL ? safe_fileno(fileSource->cFile) : 0,
188 fileSource != NULL ? fileSource->usage_count : (uintType) 0,
189 (memSizeType) fileSource,
190 fileSource == NULL ? "NULL " : "",
191 fileSource != NULL ? safe_fileno(fileSource->cFile) : 0,
192 fileSource != NULL ? fileSource->usage_count : (uintType) 0););
193 return SYS_EMPTY_OBJECT;
194 } /* fil_cpy */
195
196
197
198 /**
199 * Initialize dest/arg_1 and assign source/arg_3 to it.
200 * A create function assumes that the contents of dest/arg_1
201 * is undefined. Create functions can be used to initialize
202 * constants.
203 */
fil_create(listType arguments)204 objectType fil_create (listType arguments)
205
206 {
207 objectType source;
208 fileType fileSource;
209
210 /* fil_create */
211 source = arg_3(arguments);
212 isit_file(source);
213 fileSource = take_file(source);
214 logFunction(printf("fil_create(" FMT_U_MEM " %s%d (usage=" FMT_U "))\n",
215 (memSizeType) fileSource,
216 fileSource == NULL ? "NULL " : "",
217 fileSource != NULL ? safe_fileno(fileSource->cFile) : 0,
218 fileSource != NULL ? fileSource->usage_count : (uintType) 0););
219 SET_CATEGORY_OF_OBJ(arg_1(arguments), FILEOBJECT);
220 arg_1(arguments)->value.fileValue = fileSource;
221 if (TEMP_OBJECT(source)) {
222 source->value.fileValue = NULL;
223 } else {
224 if (fileSource != NULL && fileSource->usage_count != 0) {
225 fileSource->usage_count++;
226 } /* if */
227 } /* if */
228 logFunction(printf("fil_create --> " FMT_U_MEM " %s%d (usage=" FMT_U ")\n",
229 (memSizeType) fileSource,
230 fileSource == NULL ? "NULL " : "",
231 fileSource != NULL ? safe_fileno(fileSource->cFile) : 0,
232 fileSource != NULL ? fileSource->usage_count : (uintType) 0););
233 return SYS_EMPTY_OBJECT;
234 } /* fil_create */
235
236
237
fil_destr(listType arguments)238 objectType fil_destr (listType arguments)
239
240 {
241 fileType oldFile;
242
243 /* fil_destr */
244 isit_file(arg_1(arguments));
245 oldFile = take_file(arg_1(arguments));
246 logFunction(printf("fil_destr(" FMT_U_MEM " %s%d (usage=" FMT_U "))\n",
247 (memSizeType) oldFile,
248 oldFile == NULL ? "NULL " : "",
249 oldFile != NULL ? safe_fileno(oldFile->cFile) : 0,
250 oldFile != NULL ? oldFile->usage_count : (uintType) 0););
251 if (oldFile != NULL && oldFile->usage_count != 0) {
252 oldFile->usage_count--;
253 if (oldFile->usage_count == 0) {
254 filFree(oldFile);
255 } /* if */
256 arg_1(arguments)->value.fileValue = NULL;
257 } /* if */
258 SET_UNUSED_FLAG(arg_1(arguments));
259 return SYS_EMPTY_OBJECT;
260 } /* fil_destr */
261
262
263
264 /**
265 * Get a NULL file.
266 * Functions to open a file return NULL, if the open failed.
267 * @return NULL.
268 */
fil_empty(listType arguments)269 objectType fil_empty (listType arguments)
270
271 { /* fil_empty */
272 return bld_file_temp(&nullFileRecord);
273 } /* fil_empty */
274
275
276
277 /**
278 * Determine the end-of-file indicator.
279 * The end-of-file indicator is set if at least one request to read
280 * from the file failed.
281 * @return TRUE if the end-of-file indicator is set, FALSE otherwise.
282 */
fil_eof(listType arguments)283 objectType fil_eof (listType arguments)
284
285 { /* fil_eof */
286 isit_file(arg_1(arguments));
287 if (filEof(take_file(arg_1(arguments)))) {
288 return SYS_TRUE_OBJECT;
289 } else {
290 return SYS_FALSE_OBJECT;
291 } /* if */
292 } /* fil_eof */
293
294
295
296 /**
297 * Check if two files are equal.
298 * @return TRUE if the two files are equal,
299 * FALSE otherwise.
300 */
fil_eq(listType arguments)301 objectType fil_eq (listType arguments)
302
303 { /* fil_eq */
304 isit_file(arg_1(arguments));
305 isit_file(arg_3(arguments));
306 if (take_file(arg_1(arguments)) ==
307 take_file(arg_3(arguments))) {
308 return SYS_TRUE_OBJECT;
309 } else {
310 return SYS_FALSE_OBJECT;
311 } /* if */
312 } /* fil_eq */
313
314
315
316 /**
317 * Get the standard error file.
318 * @return stderr.
319 */
fil_err(listType arguments)320 objectType fil_err (listType arguments)
321
322 { /* fil_err */
323 return bld_file_temp(&stderrFileRecord);
324 } /* fil_err */
325
326
327
328 /**
329 * Forces that all buffered data of 'outFile' is sent to its destination.
330 * This causes data to be sent to the file system of the OS.
331 */
fil_flush(listType arguments)332 objectType fil_flush (listType arguments)
333
334 { /* fil_flush */
335 isit_file(arg_1(arguments));
336 filFlush(take_file(arg_1(arguments)));
337 return SYS_EMPTY_OBJECT;
338 } /* fil_flush */
339
340
341
342 /**
343 * Read a character from a clib_file.
344 * @return the character read, or EOF at the end of the file.
345 */
fil_getc(listType arguments)346 objectType fil_getc (listType arguments)
347
348 { /* fil_getc */
349 isit_file(arg_1(arguments));
350 return bld_char_temp(
351 filGetcChkCtrlC(take_file(arg_1(arguments))));
352 } /* fil_getc */
353
354
355
356 /**
357 * Read a string with a maximum length from an clib_file.
358 * @return the string read.
359 * @exception RANGE_ERROR The length is negative.
360 * @exception MEMORY_ERROR Not enough memory to represent the result.
361 * @exception FILE_ERROR A system function returns an error.
362 */
fil_gets(listType arguments)363 objectType fil_gets (listType arguments)
364
365 { /* fil_gets */
366 isit_file(arg_1(arguments));
367 isit_int(arg_2(arguments));
368 return bld_stri_temp(
369 filGetsChkCtrlC(take_file(arg_1(arguments)),
370 take_int(arg_2(arguments))));
371 } /* fil_gets */
372
373
374
375 /**
376 * Determine if at least one character can be read successfully.
377 * This function allows a file to be handled like an iterator.
378 * @return FALSE if 'getc' would return EOF, TRUE otherwise.
379 */
fil_has_next(listType arguments)380 objectType fil_has_next (listType arguments)
381
382 { /* fil_has_next */
383 isit_file(arg_1(arguments));
384 if (filHasNextChkCtrlC(take_file(arg_1(arguments)))) {
385 return SYS_TRUE_OBJECT;
386 } else {
387 return SYS_FALSE_OBJECT;
388 } /* if */
389 } /* fil_has_next */
390
391
392
393 /**
394 * Get the standard input file.
395 * @return stdin.
396 */
fil_in(listType arguments)397 objectType fil_in (listType arguments)
398
399 { /* fil_in */
400 return bld_file_temp(&stdinFileRecord);
401 } /* fil_in */
402
403
404
405 /**
406 * Determine if at least one character can be read without blocking.
407 * Blocking means that 'getc' would wait until a character is
408 * received. Blocking can last for a period of unspecified length.
409 * Regular files do not block.
410 * @return TRUE if 'getc' would not block, FALSE otherwise.
411 */
fil_input_ready(listType arguments)412 objectType fil_input_ready (listType arguments)
413
414 { /* fil_input_ready */
415 isit_file(arg_1(arguments));
416 if (filInputReady(take_file(arg_1(arguments)))) {
417 return SYS_TRUE_OBJECT;
418 } else {
419 return SYS_FALSE_OBJECT;
420 } /* if */
421 } /* fil_input_ready */
422
423
424
425 /**
426 * Read a line from a clib_file.
427 * The function accepts lines ending with "\n", "\r\n" or EOF.
428 * The line ending characters are not copied into the string.
429 * That means that the "\r" of a "\r\n" sequence is silently removed.
430 * When the function is left the 2nd parameter (terminationChar)
431 * contains '\n' or EOF.
432 * @return the line read.
433 * @exception MEMORY_ERROR Not enough memory to represent the result.
434 * @exception FILE_ERROR A system function returns an error.
435 */
fil_line_read(listType arguments)436 objectType fil_line_read (listType arguments)
437
438 {
439 objectType terminationChar;
440
441 /* fil_line_read */
442 isit_file(arg_1(arguments));
443 terminationChar = arg_2(arguments);
444 isit_char(terminationChar);
445 is_variable(terminationChar);
446 return bld_stri_temp(
447 filLineReadChkCtrlC(take_file(arg_1(arguments)),
448 &terminationChar->value.charValue));
449 } /* fil_line_read */
450
451
452
fil_lit(listType arguments)453 objectType fil_lit (listType arguments)
454
455 { /* fil_lit */
456 isit_file(arg_1(arguments));
457 return bld_stri_temp(
458 filLit(take_file(arg_1(arguments))));
459 } /* fil_lit */
460
461
462
463 /**
464 * Obtain the length of a clib_file.
465 * The file length is measured in bytes.
466 * @return the size of the given file.
467 * @exception RANGE_ERROR The file length does not fit into
468 * an integer value.
469 * @exception FILE_ERROR A system function returns an error or the
470 * file length reported by the system is negative.
471 */
fil_lng(listType arguments)472 objectType fil_lng (listType arguments)
473
474 { /* fil_lng */
475 isit_file(arg_1(arguments));
476 return bld_int_temp(
477 filLng(take_file(arg_1(arguments))));
478 } /* fil_lng */
479
480
481
482 /**
483 * Check if two files are not equal.
484 * @return FALSE if both files are equal,
485 * TRUE otherwise.
486 */
fil_ne(listType arguments)487 objectType fil_ne (listType arguments)
488
489 { /* fil_ne */
490 isit_file(arg_1(arguments));
491 isit_file(arg_3(arguments));
492 if (take_file(arg_1(arguments)) !=
493 take_file(arg_3(arguments))) {
494 return SYS_TRUE_OBJECT;
495 } else {
496 return SYS_FALSE_OBJECT;
497 } /* if */
498 } /* fil_ne */
499
500
501
502 /**
503 * Opens a file with the specified 'path' and 'mode'.
504 * There are text modes and binary modes:
505 * - Binary modes:
506 * - "r" Open file for reading.
507 * - "w" Truncate to zero length or create file for writing.
508 * - "a" Append; open or create file for writing at end-of-file.
509 * - "r+" Open file for update (reading and writing).
510 * - "w+" Truncate to zero length or create file for update.
511 * - "a+" Append; open or create file for update, writing at end-of-file.
512 * - Text modes:
513 * - "rt" Open file for reading.
514 * - "wt" Truncate to zero length or create file for writing.
515 * - "at" Append; open or create file for writing at end-of-file.
516 * - "rt+" Open file for update (reading and writing).
517 * - "wt+" Truncate to zero length or create file for update.
518 * - "at+" Append; open or create file for update, writing at end-of-file.
519 *
520 * Note that this modes differ from the ones used by the C function
521 * fopen().
522 * @param path/arg_1 Path of the file to be opened. The path must
523 * use the standard path representation.
524 * @param mode/arg_2 Mode of the file to be opened.
525 * @return the file opened, or NULL if it could not be opened or
526 * if 'path' refers to a directory.
527 * @exception MEMORY_ERROR Not enough memory to convert the path
528 * to the system path type.
529 * @exception RANGE_ERROR The 'mode' is not one of the allowed
530 * values or 'path' does not use the standard path
531 * representation or 'path' cannot be converted
532 * to the system path type.
533 */
fil_open(listType arguments)534 objectType fil_open (listType arguments)
535
536 { /* fil_open */
537 isit_stri(arg_1(arguments));
538 isit_stri(arg_2(arguments));
539 return bld_file_temp(
540 filOpen(take_stri(arg_1(arguments)), take_stri(arg_2(arguments))));
541 } /* fil_open */
542
543
544
545 /**
546 * Open the null device of the operation system for reading and writing.
547 * @return the null device opened, or NULL if it could not be opened.
548 */
fil_open_null_device(listType arguments)549 objectType fil_open_null_device (listType arguments)
550
551 { /* fil_open_null_device */
552 return bld_file_temp(filOpenNullDevice());
553 } /* fil_open_null_device */
554
555
556
557 /**
558 * Get the standard output file.
559 * @return stdout.
560 */
fil_out(listType arguments)561 objectType fil_out (listType arguments)
562
563 { /* fil_out */
564 return bld_file_temp(&stdoutFileRecord);
565 } /* fil_out */
566
567
568
569 /**
570 * Wait for the process associated with aPipe/arg_1 to terminate.
571 * @param aPipe Pipe to be closed (created by 'fil_popen').
572 * @exception FILE_ERROR A system function returned an error.
573 */
fil_pclose(listType arguments)574 objectType fil_pclose (listType arguments)
575
576 { /* fil_pclose */
577 isit_file(arg_1(arguments));
578 filPclose(take_file(arg_1(arguments)));
579 return SYS_EMPTY_OBJECT;
580 } /* fil_pclose */
581
582
583
fil_pipe(listType arguments)584 objectType fil_pipe (listType arguments)
585
586 {
587 objectType inFile;
588 objectType outFile;
589
590 /* fil_pipe */
591 inFile = arg_1(arguments);
592 isit_file(inFile);
593 is_variable(inFile);
594 outFile = arg_2(arguments);
595 isit_file(outFile);
596 is_variable(outFile);
597 filPipe(&take_file(inFile), &take_file(outFile));
598 return SYS_EMPTY_OBJECT;
599 } /* fil_pipe */
600
601
602
603 /**
604 * Open a pipe to a shell 'command', with 'parameters'.
605 * The pipe can be used to read, respectively write data
606 * with Latin-1 or UTF-8 encoding. Parameters which contain
607 * a space must be enclosed in double quotes. The commands
608 * supported and the format of the 'parameters' are not
609 * covered by the description of the 'fil_popen' function.
610 * Due to the usage of the operating system shell and external
611 * programs, it is hard to write portable programs, which use
612 * the 'fil_popen' function.
613 * @param command/arg_1 Name of the command to be executed. A path must
614 * use the standard path representation.
615 * @param parameters/arg_2 Space separated list of parameters for
616 * the 'command', or "" if there are no parameters.
617 * @param mode/arg_3 A pipe can be opened with the binary modes
618 * "r" (read) and "w" (write) or with the text modes
619 * "rt" (read) and "wt" (write).
620 * @return the pipe file opened, or NULL if it could not be opened.
621 * @exception RANGE_ERROR 'command' is not representable as
622 * operating system path, or 'mode' is illegal.
623 */
fil_popen(listType arguments)624 objectType fil_popen (listType arguments)
625
626 { /* fil_popen */
627 isit_stri(arg_1(arguments));
628 isit_stri(arg_2(arguments));
629 isit_stri(arg_3(arguments));
630 return bld_file_temp(
631 filPopen(take_stri(arg_1(arguments)), take_stri(arg_2(arguments)),
632 take_stri(arg_3(arguments))));
633 } /* fil_popen */
634
635
636
fil_print(listType arguments)637 objectType fil_print (listType arguments)
638
639 { /* fil_print */
640 isit_stri(arg_1(arguments));
641 filPrint(take_stri(arg_1(arguments)));
642 return SYS_EMPTY_OBJECT;
643 } /* fil_print */
644
645
646
647 /**
648 * Set the current file position.
649 * The file position is measured in bytes from the start of the file.
650 * The first byte in the file has the position 1.
651 * @exception RANGE_ERROR The file position is negative or zero or
652 * the file position is not representable in the system
653 * file position type.
654 * @exception FILE_ERROR A system function returns an error.
655 */
fil_seek(listType arguments)656 objectType fil_seek (listType arguments)
657
658 { /* fil_seek */
659 isit_file(arg_1(arguments));
660 isit_int(arg_2(arguments));
661 filSeek(take_file(arg_1(arguments)),
662 take_int(arg_2(arguments)));
663 return SYS_EMPTY_OBJECT;
664 } /* fil_seek */
665
666
667
668 /**
669 * Determine if the file aFile/arg_1 is seekable.
670 * If a file is seekable the functions filSeek() and filTell()
671 * can be used to set and and obtain the current file position.
672 * @return TRUE, if aFile/arg_1 is seekable, FALSE otherwise.
673 */
fil_seekable(listType arguments)674 objectType fil_seekable (listType arguments)
675
676 { /* fil_seekable */
677 isit_file(arg_1(arguments));
678 if (filSeekable(take_file(arg_1(arguments)))) {
679 return SYS_TRUE_OBJECT;
680 } else {
681 return SYS_FALSE_OBJECT;
682 } /* if */
683 } /* fil_seekable */
684
685
686
fil_setbuf(listType arguments)687 objectType fil_setbuf (listType arguments)
688
689 { /* fil_setbuf */
690 isit_file(arg_1(arguments));
691 isit_int(arg_2(arguments));
692 isit_int(arg_3(arguments));
693 filSetbuf(take_file(arg_1(arguments)),
694 take_int(arg_2(arguments)), take_int(arg_3(arguments)));
695 return SYS_EMPTY_OBJECT;
696 } /* fil_setbuf */
697
698
699
700 /**
701 * Obtain the current file position.
702 * The file position is measured in bytes from the start of the file.
703 * The first byte in the file has the position 1.
704 * @return the current file position.
705 * @exception RANGE_ERROR The file position does not fit into
706 * an integer value.
707 * @exception FILE_ERROR A system function returns an error or the
708 * file position reported by the system is negative.
709 */
fil_tell(listType arguments)710 objectType fil_tell (listType arguments)
711
712 { /* fil_tell */
713 isit_file(arg_1(arguments));
714 return bld_int_temp(
715 filTell(take_file(arg_1(arguments))));
716 } /* fil_tell */
717
718
719
720 /**
721 * Truncate 'aFile/arg_1' to the given 'length/arg_2'.
722 * If the file previously was larger than 'length/arg_2', the extra data is lost.
723 * If the file previously was shorter, it is extended, and the extended
724 * part is filled with null bytes ('\0;').
725 * @param aFile/arg_1 File to be truncated.
726 * @param length/arg_2 Requested length of 'aFile/arg_1' in bytes.
727 * @exception RANGE_ERROR The requested length is negative or
728 * the length is not representable in the type
729 * used by the system function.
730 * @exception FILE_ERROR A system function returns an error.
731 */
fil_truncate(listType arguments)732 objectType fil_truncate (listType arguments)
733
734 { /* fil_truncate */
735 isit_file(arg_1(arguments));
736 isit_int(arg_2(arguments));
737 filTruncate(take_file(arg_1(arguments)),
738 take_int(arg_2(arguments)));
739 return SYS_EMPTY_OBJECT;
740 } /* fil_truncate */
741
742
743
744 /**
745 * Get 'clib_file' value of the object referenced by 'aReference/arg_1'.
746 * @return the 'clib_file' value of the referenced object.
747 * @exception RANGE_ERROR If 'aReference/arg_1' is NIL or
748 * category(aReference) <> FILEOBJECT holds.
749 */
fil_value(listType arguments)750 objectType fil_value (listType arguments)
751
752 {
753 objectType aReference;
754
755 /* fil_value */
756 isit_reference(arg_1(arguments));
757 aReference = take_reference(arg_1(arguments));
758 if (unlikely(aReference == NULL ||
759 CATEGORY_OF_OBJ(aReference) != FILEOBJECT)) {
760 logError(printf("fil_value(");
761 trace1(aReference);
762 printf("): Category is not FILEOBJECT.\n"););
763 return raise_exception(SYS_RNG_EXCEPTION);
764 } else {
765 return bld_file_temp(take_file(aReference));
766 } /* if */
767 } /* fil_value */
768
769
770
771 /**
772 * Read a word from a clib_file.
773 * Before reading the word it skips spaces and tabs. The function
774 * accepts words ending with " ", "\t", "\n", "\r\n" or EOF.
775 * The word ending characters are not copied into the string.
776 * That means that the "\r" of a "\r\n" sequence is silently removed.
777 * When the function is left the 2nd parameter (terminationChar)
778 * contains ' ', '\t', '\n' or EOF.
779 * @return the word read.
780 * @exception MEMORY_ERROR Not enough memory to represent the result.
781 * @exception FILE_ERROR A system function returns an error.
782 */
fil_word_read(listType arguments)783 objectType fil_word_read (listType arguments)
784
785 {
786 objectType terminationChar;
787
788 /* fil_word_read */
789 isit_file(arg_1(arguments));
790 terminationChar = arg_2(arguments);
791 isit_char(terminationChar);
792 is_variable(terminationChar);
793 return bld_stri_temp(
794 filWordReadChkCtrlC(take_file(arg_1(arguments)),
795 &terminationChar->value.charValue));
796 } /* fil_word_read */
797
798
799
800 /**
801 * Write a string to a clib_file.
802 * @exception FILE_ERROR A system function returns an error.
803 * @exception RANGE_ERROR The string contains a character that does
804 * not fit into a byte.
805 */
fil_write(listType arguments)806 objectType fil_write (listType arguments)
807
808 { /* fil_write */
809 isit_file(arg_1(arguments));
810 isit_stri(arg_2(arguments));
811 filWrite(take_file(arg_1(arguments)), take_stri(arg_2(arguments)));
812 return SYS_EMPTY_OBJECT;
813 } /* fil_write */
814