1/* 2 Title: Basic IO. 3 4 Copyright (c) 2000, 2015-2017 David C. J. Matthews 5 6 Portions of this code are derived from the original stream io 7 package copyright CUTS 1983-2000. 8 9 This library is free software; you can redistribute it and/or 10 modify it under the terms of the GNU Lesser General Public 11 License version 2.1 as published by the Free Software Foundation. 12 13 This library is distributed in the hope that it will be useful, 14 but WITHOUT ANY WARRANTY; without even the implied warranty of 15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 16 Lesser General Public License for more details. 17 18 You should have received a copy of the GNU Lesser General Public 19 License along with this library; if not, write to the Free Software 20 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 21 22*/ 23 24/* 25This module replaces the old stream IO based on stdio. It works at a 26lower level with the buffering being done in ML. 27Sockets are generally dealt with in network.c but it is convenient to 28use the same table for them particularly since it simplifies the 29implementation of "poll". 30Directory operations are also included in here. 31DCJM May 2000. 32*/ 33#ifdef HAVE_CONFIG_H 34#include "config.h" 35#elif defined(_WIN32) 36#include "winconfig.h" 37#else 38#error "No configuration file" 39#endif 40 41#ifdef HAVE_FCNTL_H 42#include <fcntl.h> 43#endif 44#ifdef HAVE_SYS_TYPES_H 45#include <sys/types.h> 46#endif 47#ifdef HAVE_SYS_STAT_H 48#include <sys/stat.h> 49#endif 50#ifdef HAVE_ASSERT_H 51#include <assert.h> 52#define ASSERT(x) assert(x) 53#else 54#define ASSERT(x) 0 55#endif 56#ifdef HAVE_ERRNO_H 57#include <errno.h> 58#endif 59#ifdef HAVE_SIGNAL_H 60#include <signal.h> 61#endif 62#ifdef HAVE_STDLIB_H 63#include <stdlib.h> 64#endif 65#ifdef HAVE_ALLOCA_H 66#include <alloca.h> 67#endif 68#ifdef HAVE_IO_H 69#include <io.h> 70#endif 71#ifdef HAVE_SYS_PARAM_H 72#include <sys/param.h> 73#endif 74#ifdef HAVE_SYS_IOCTL_H 75#include <sys/ioctl.h> 76#endif 77#ifdef HAVE_SYS_TIME_H 78#include <sys/time.h> 79#endif 80#ifdef HAVE_UNISTD_H 81#include <unistd.h> 82#endif 83#ifdef HAVE_POLL_H 84#include <poll.h> 85#endif 86#ifdef HAVE_STRING_H 87#include <string.h> 88#endif 89#ifdef HAVE_SYS_SELECT_H 90#include <sys/select.h> 91#endif 92#ifdef HAVE_MALLOC_H 93#include <malloc.h> 94#endif 95#ifdef HAVE_DIRECT_H 96#include <direct.h> 97#endif 98#ifdef HAVE_STDIO_H 99#include <stdio.h> 100#endif 101#include <limits> 102 103#if (defined(_WIN32) && ! defined(__CYGWIN__)) 104#include <winsock2.h> 105#include <tchar.h> 106#else 107typedef char TCHAR; 108#define _T(x) x 109#define lstrcat strcat 110#define _topen open 111#define _tmktemp mktemp 112#define _tcsdup strdup 113#endif 114 115#ifndef O_BINARY 116#define O_BINARY 0 /* Not relevant. */ 117#endif 118#ifndef INFTIM 119#define INFTIM (-1) 120#endif 121 122#include "globals.h" 123#include "basicio.h" 124#include "sys.h" 125#include "gc.h" 126#include "run_time.h" 127#include "machine_dep.h" 128#include "arb.h" 129#include "processes.h" 130#include "diagnostics.h" 131#include "io_internal.h" 132#include "scanaddrs.h" 133#include "polystring.h" 134#include "mpoly.h" 135#include "save_vec.h" 136#include "rts_module.h" 137#include "locking.h" 138#include "rtsentry.h" 139 140#if (defined(_WIN32) && ! defined(__CYGWIN__)) 141#include "Console.h" 142#define TOOMANYFILES ERROR_NO_MORE_FILES 143#define NOMEMORY ERROR_NOT_ENOUGH_MEMORY 144#define STREAMCLOSED ERROR_INVALID_HANDLE 145#define FILEDOESNOTEXIST ERROR_FILE_NOT_FOUND 146#define ERRORNUMBER _doserrno 147#else 148#define TOOMANYFILES EMFILE 149#define NOMEMORY ENOMEM 150#define STREAMCLOSED EBADF 151#define FILEDOESNOTEXIST ENOENT 152#define ERRORNUMBER errno 153#endif 154 155#ifndef O_ACCMODE 156#define O_ACCMODE (O_RDONLY|O_RDWR|O_WRONLY) 157#endif 158 159#define STREAMID(x) (DEREFSTREAMHANDLE(x)->streamNo) 160 161#define SAVE(x) taskData->saveVec.push(x) 162 163#ifdef _MSC_VER 164// Don't tell me about ISO C++ changes. 165#pragma warning(disable:4996) 166#endif 167 168extern "C" { 169 POLYEXTERNALSYMBOL POLYUNSIGNED PolyChDir(PolyObject *threadId, PolyWord arg); 170 POLYEXTERNALSYMBOL POLYUNSIGNED PolyBasicIOGeneral(PolyObject *threadId, PolyWord code, PolyWord strm, PolyWord arg); 171} 172 173/* Points to tokens which represent the streams and the stream itself. 174 For each stream a single word token is made containing the file 175 number, and its address is put in here. When the stream is closed 176 the entry is overwritten. Any further activity will be trapped 177 because the address in the vector will not be the same as the 178 address of the token. This also prevents streams other than stdin 179 and stdout from being made persistent. stdin, stdout and stderr are 180 treated specially. The tokens for them are entries in the 181 interface vector and so can be made persistent. */ 182/* 183I've tried various ways of getting asynchronous IO to work in a 184consistent manner across different kinds of IO devices in Windows. 185It is possible to pass some kinds of handles to WaitForMultipleObjects 186but not all. Anonymous pipes, for example, cannot be used in Windows 95 187and don't seem to do what is expected in Windows NT (they return signalled 188even when there is no input). The console is even more of a mess. The 189handle is signalled when there are any events (such as mouse movements) 190available but these are ignored by ReadFile, which may then block. 191Conversely using ReadFile to read less than a line causes the handle 192to be unsignalled, supposedly meaning that no input is available, yet 193ReadFile will return subsequent characters without blocking. The eventual 194solution was to replace the console completely. 195DCJM May 2000 196*/ 197 198PIOSTRUCT basic_io_vector; 199PLock ioLock; // Currently this just protects against two threads using the same entry 200 201#if (defined(_WIN32) && ! defined(__CYGWIN__)) 202class WaitStream: public WaitHandle 203{ 204public: 205 WaitStream(PIOSTRUCT strm): WaitHandle(strm == NULL ? NULL : strm->hAvailable) {} 206}; 207 208#else 209 210class WaitStream: public WaitInputFD 211{ 212public: 213 WaitStream(PIOSTRUCT strm): WaitInputFD(strm == NULL ? -1 : strm->device.ioDesc) {} 214}; 215#endif 216 217#if (defined(_WIN32) && ! defined(__CYGWIN__)) 218 219/* Deal with the various cases to see if input is available. */ 220static bool isAvailable(TaskData *taskData, PIOSTRUCT strm) 221{ 222 HANDLE hFile = (HANDLE)_get_osfhandle(strm->device.ioDesc); 223 224 if (isPipe(strm)) 225 { 226 DWORD dwAvail; 227 int err; 228 if (PeekNamedPipe(hFile, NULL, 0, NULL, &dwAvail, NULL)) 229 return dwAvail != 0; 230 err = GetLastError(); 231 /* Windows returns ERROR_BROKEN_PIPE on input whereas Unix 232 only returns it on output and treats it as EOF. We 233 follow Unix here. */ 234 if (err == ERROR_BROKEN_PIPE) 235 return true; /* At EOF - will not block. */ 236 else raise_syscall(taskData, "PeekNamedPipe error", err); 237 /*NOTREACHED*/ 238 } 239 240 else if (isConsole(strm)) return isConsoleInput(); 241 242 else if (isDevice(strm)) 243 return WaitForSingleObject(hFile, 0) == WAIT_OBJECT_0; 244 else 245 /* File - We may be at end-of-file but we won't block. */ 246 return true; 247} 248 249#else 250static bool isAvailable(TaskData *taskData, PIOSTRUCT strm) 251{ 252#ifdef __CYGWIN__ 253 static struct timeval poll = {0,1}; 254#else 255 static struct timeval poll = {0,0}; 256#endif 257 fd_set read_fds; 258 int selRes; 259 FD_ZERO(&read_fds); 260 FD_SET((int)strm->device.ioDesc, &read_fds); 261 262 /* If there is something there we can return. */ 263 selRes = select(FD_SETSIZE, &read_fds, NULL, NULL, &poll); 264 if (selRes > 0) return true; /* Something waiting. */ 265 else if (selRes < 0 && errno != EINTR) // Maybe another thread closed descr 266 raise_syscall(taskData, "select error", ERRORNUMBER); 267 else return false; 268} 269 270#endif 271 272static POLYUNSIGNED max_streams; 273 274/* If we try opening a stream and it fails with EMFILE (too many files 275 open) we may be able to recover by garbage-collecting and closing some 276 unreferenced streams. This flag is set to indicate that we have had 277 an EMFILE error and is cleared whenever a file is closed or opened 278 successfully. It prevents infinite looping if we really have too 279 many files. */ 280bool emfileFlag = false; 281 282/* Close a stream, either explicitly or as a result of detecting an 283 unreferenced stream in the g.c. Doesn't report any errors. */ 284void close_stream(PIOSTRUCT str) 285{ 286 if (!isOpen(str)) return; 287 if (isDirectory(str)) 288 { 289#if (defined(_WIN32) && ! defined(__CYGWIN__)) 290 FindClose(str->device.directory.hFind); 291#else 292 closedir(str->device.ioDir); 293#endif 294 } 295#if (defined(_WIN32) && ! defined(__CYGWIN__)) 296 else if (isSocket(str)) 297 { 298 closesocket(str->device.sock); 299 } 300 else if (isConsole(str)) return; 301#endif 302 else close(str->device.ioDesc); 303 str->ioBits = 0; 304 str->token = TAGGED(0); 305 emfileFlag = false; 306#if (defined(_WIN32) && ! defined(__CYGWIN__)) 307 if (str->hAvailable) CloseHandle(str->hAvailable); 308 str->hAvailable = NULL; 309#endif 310} 311 312PIOSTRUCT get_stream(PolyWord stream_token) 313/* Checks that the stream number is valid and returns the actual stream. 314 Returns NULL if the stream is closed. */ 315{ 316 POLYUNSIGNED stream_no; 317 if (stream_token.IsTagged()) 318 stream_no = stream_token.UnTaggedUnsigned(); 319 else stream_no = ((StreamToken*)stream_token.AsObjPtr())->streamNo; 320 321 if (stream_no >= max_streams) 322 return 0; 323 if (basic_io_vector[stream_no].token != stream_token) 324 { 325 // Backwards compatibility. The persistent streams may either be 326 // tagged values or IO entry pointers. 327 if (stream_no >= 3) 328 return 0; 329 } 330 if (! isOpen(&basic_io_vector[stream_no])) 331 return 0; 332 333 return &basic_io_vector[stream_no]; 334} 335 336Handle make_stream_entry(TaskData *taskData) 337// Find a free entry in the stream vector and return a token for it. 338{ 339 POLYUNSIGNED stream_no; 340 341 ioLock.Lock(); 342 // Find an unused entry. 343 for(stream_no = 0; 344 stream_no < max_streams && basic_io_vector[stream_no].token != ClosedToken; 345 stream_no++); 346 347 /* Check we have enough space. */ 348 if (stream_no >= max_streams) 349 { /* No space. */ 350 POLYUNSIGNED oldMax = max_streams; 351 max_streams += max_streams/2; 352 PIOSTRUCT newVector = 353 (PIOSTRUCT)realloc(basic_io_vector, max_streams*sizeof(IOSTRUCT)); 354 if (newVector == NULL) return NULL; 355 basic_io_vector = newVector; 356 /* Clear the new space. */ 357 memset(basic_io_vector+oldMax, 0, (max_streams-oldMax)*sizeof(IOSTRUCT)); 358 for (POLYUNSIGNED i = oldMax; i < max_streams; i++) 359 basic_io_vector[i].token = ClosedToken; 360 } 361 362 // Create the token. This must be mutable not because it will be updated but 363 // because we will use pointer-equality on it and the GC does not guarantee to 364 // preserve pointer-equality for immutables. 365 Handle str_token = 366 alloc_and_save(taskData, (sizeof(StreamToken) + sizeof(PolyWord) - 1)/sizeof(PolyWord), 367 F_BYTE_OBJ|F_MUTABLE_BIT); 368 STREAMID(str_token) = stream_no; 369 370 ASSERT(!isOpen(&basic_io_vector[stream_no])); 371 /* Clear the entry then set the token. */ 372 memset(&basic_io_vector[stream_no], 0, sizeof(IOSTRUCT)); 373 basic_io_vector[stream_no].token = str_token->Word(); 374 375 ioLock.Unlock(); 376 377 return str_token; 378} 379 380/******************************************************************************/ 381/* */ 382/* free_stream_entry - utility function */ 383/* */ 384/******************************************************************************/ 385/* Free an entry in the stream vector - used when openstreamc grabs a 386 stream vector entry, but then fails to open the associated file. 387 (This happens frequently when we are using the Poly make system.) 388 If we don't recycle the stream vector entries immediately we quickly 389 run out and must perform a full garbage collection to recover 390 the unused ones. SPF 12/9/95 391*/ 392void free_stream_entry(POLYUNSIGNED stream_no) 393{ 394 ASSERT(stream_no < max_streams); 395 396 ioLock.Lock(); 397 basic_io_vector[stream_no].token = ClosedToken; 398 basic_io_vector[stream_no].ioBits = 0; 399 ioLock.Unlock(); 400} 401 402#if (defined(_WIN32) && ! defined(__CYGWIN__)) 403// When testing for available input we need to do it differently depending on 404// the kind of handle we have. 405static int getFileType(int stream) 406{ 407 if (stream == 0 && hOldStdin == INVALID_HANDLE_VALUE) 408 /* If this is stdio and we're using our own console.*/ 409 return IO_BIT_GUI_CONSOLE; 410 switch (GetFileType((HANDLE)_get_osfhandle(stream))) 411 { 412 case FILE_TYPE_PIPE: return IO_BIT_PIPE; 413 case FILE_TYPE_CHAR: return IO_BIT_DEV; 414 default: return 0; 415 } 416} 417#endif 418 419/* Open a file in the required mode. */ 420static Handle open_file(TaskData *taskData, Handle filename, int mode, int access, int isPosix) 421{ 422 while (true) // Repeat only with certain kinds of errors 423 { 424 TempString cFileName(filename->Word()); // Get file name 425 if (cFileName == 0) raise_syscall(taskData, "Insufficient memory", NOMEMORY); 426 Handle str_token = make_stream_entry(taskData); 427 if (str_token == NULL) raise_syscall(taskData, "Insufficient memory", NOMEMORY); 428 POLYUNSIGNED stream_no = STREAMID(str_token); 429 int stream = _topen(cFileName, mode, access); 430 431 if (stream >= 0) 432 { 433 PIOSTRUCT strm = &basic_io_vector[stream_no]; 434 strm->device.ioDesc = stream; 435 strm->ioBits = IO_BIT_OPEN; 436 if ((mode & O_ACCMODE) != O_WRONLY) 437 strm->ioBits |= IO_BIT_READ; 438 if ((mode & O_ACCMODE) != O_RDONLY) 439 strm->ioBits |= IO_BIT_WRITE; 440#if (defined(_WIN32) && ! defined(__CYGWIN__)) 441 strm->ioBits |= getFileType(stream); 442#else 443 if (! isPosix) 444 { 445 /* Set the close-on-exec flag. We don't set this if we are being 446 called from one of the low level functions in the Posix structure. 447 I assume that if someone is using those functions they know what 448 they're doing and would expect the behaviour to be close to that 449 of the underlying function. */ 450 fcntl(stream, F_SETFD, 1); 451 } 452#endif 453 emfileFlag = false; /* Successful open. */ 454 return str_token; 455 } 456 457 free_stream_entry(stream_no); 458 switch (errno) 459 { 460 case EINTR: // Just try the call. Is it possible to block here indefinitely? 461 continue; 462 case EMFILE: /* too many open files */ 463 { 464 if (emfileFlag) /* Previously had an EMFILE error. */ 465 raise_syscall(taskData, "Cannot open", TOOMANYFILES); 466 emfileFlag = true; 467 FullGC(taskData); /* May clear emfileFlag if we close a file. */ 468 continue; 469 } 470 default: 471 raise_syscall(taskData, "Cannot open", ERRORNUMBER); 472 /*NOTREACHED*/ 473 return 0; 474 } 475 } 476} 477 478/* Close the stream unless it is stdin or stdout or already closed. */ 479static Handle close_file(TaskData *taskData, Handle stream) 480{ 481 // Closed streams, stdin, stdout or stderr are all short ints. 482 if (stream->Word().IsDataPtr()) 483 { 484 PIOSTRUCT strm = get_stream(stream->Word()); 485 if (strm != NULL && strm->token.IsTagged()) strm = NULL; // Backwards compatibility for stdin etc. 486 // Ignore closed streams, stdin, stdout or stderr. 487 if (strm != NULL) close_stream(strm); 488 } 489 490 return Make_fixed_precision(taskData, 0); 491} 492 493/* Read into an array. */ 494// We can't combine readArray and readString because we mustn't compute the 495// destination of the data in readArray until after any GC. 496static Handle readArray(TaskData *taskData, Handle stream, Handle args, bool/*isText*/) 497{ 498 /* The isText argument is ignored in both Unix and Windows but 499 is provided for future use. Windows remembers the mode used 500 when the file was opened to determine whether to translate 501 CRLF into LF. */ 502 // We should check for interrupts even if we're not going to block. 503 processes->TestAnyEvents(taskData); 504 505 while (1) // Loop if interrupted. 506 { 507 // First test to see if we have input available. 508 // These tests may result in a GC if another thread is running. 509 // First test to see if we have input available. 510 // These tests may result in a GC if another thread is running. 511 PIOSTRUCT strm; 512 513 while (true) { 514 strm = get_stream(stream->Word()); 515 /* Raise an exception if the stream has been closed. */ 516 if (strm == NULL) raise_syscall(taskData, "Stream is closed", STREAMCLOSED); 517 if (isAvailable(taskData, strm)) 518 break; 519 WaitStream waiter(strm); 520 processes->ThreadPauseForIO(taskData, &waiter); 521 } 522 523#if (defined(_WIN32) && ! defined(__CYGWIN__)) 524 if (strm->hAvailable != NULL) ResetEvent(strm->hAvailable); 525#endif 526 // We can now try to read without blocking. 527 // Actually there's a race here in the unlikely situation that there 528 // are multiple threads sharing the same low-level reader. They could 529 // both detect that input is available but only one may succeed in 530 // reading without blocking. This doesn't apply where the threads use 531 // the higher-level IO interfaces in ML which have their own mutexes. 532 int fd = strm->device.ioDesc; 533 byte *base = DEREFHANDLE(args)->Get(0).AsObjPtr()->AsBytePtr(); 534 POLYUNSIGNED offset = getPolyUnsigned(taskData, DEREFWORDHANDLE(args)->Get(1)); 535#if (defined(_WIN32) && ! defined(__CYGWIN__)) 536 unsigned length = get_C_unsigned(taskData, DEREFWORDHANDLE(args)->Get(2)); 537 int haveRead; 538#else 539 size_t length = getPolyUnsigned(taskData, DEREFWORDHANDLE(args)->Get(2)); 540 ssize_t haveRead; 541#endif 542#if (defined(_WIN32) && ! defined(__CYGWIN__)) 543 if (isConsole(strm)) 544 haveRead = getConsoleInput((char*)base+offset, length); 545 else 546#endif 547 // Unix and Windows other than console. 548 haveRead = read(fd, base+offset, length); 549 if (haveRead >= 0) 550 return Make_fixed_precision(taskData, haveRead); // Success. 551 // If it failed because it was interrupted keep trying otherwise it's an error. 552 if (errno != EINTR) 553 raise_syscall(taskData, "Error while reading", ERRORNUMBER); 554 } 555} 556 557/* Return input as a string. We don't actually need both readArray and 558 readString but it's useful to have both to reduce unnecessary garbage. 559 The IO library will construct one from the other but the higher levels 560 choose the appropriate function depending on need. */ 561static Handle readString(TaskData *taskData, Handle stream, Handle args, bool/*isText*/) 562{ 563#if (defined(_WIN32) && ! defined(__CYGWIN__)) 564 int length = get_C_int(taskData, DEREFWORD(args)); 565 int haveRead; 566#else 567 size_t length = getPolyUnsigned(taskData, DEREFWORD(args)); 568 ssize_t haveRead; 569#endif 570 // We should check for interrupts even if we're not going to block. 571 processes->TestAnyEvents(taskData); 572 573 while (1) // Loop if interrupted. 574 { 575 // First test to see if we have input available. 576 // These tests may result in a GC if another thread is running. 577 PIOSTRUCT strm; 578 579 while (true) { 580 strm = get_stream(DEREFWORD(stream)); 581 /* Raise an exception if the stream has been closed. */ 582 if (strm == NULL) raise_syscall(taskData, "Stream is closed", STREAMCLOSED); 583 if (isAvailable(taskData, strm)) 584 break; 585 WaitStream waiter(strm); 586 processes->ThreadPauseForIO(taskData, &waiter); 587 } 588 589#if (defined(_WIN32) && ! defined(__CYGWIN__)) 590 if (strm->hAvailable != NULL) ResetEvent(strm->hAvailable); 591#endif 592 593 // We can now try to read without blocking. 594 int fd = strm->device.ioDesc; 595 // We previously allocated the buffer on the stack but that caused 596 // problems with multi-threading at least on Mac OS X because of 597 // stack exhaustion. We limit the space to 100k. */ 598 if (length > 102400) length = 102400; 599 byte *buff = (byte*)malloc(length); 600 if (buff == 0) raise_syscall(taskData, "Unable to allocate buffer", NOMEMORY); 601 602#if (defined(_WIN32) && ! defined(__CYGWIN__)) 603 if (isConsole(strm)) 604 haveRead = getConsoleInput((char*)buff, length); 605 else 606#endif 607 // Unix and Windows other than console. 608 haveRead = read(fd, buff, length); 609 if (haveRead >= 0) 610 { 611 Handle result = SAVE(C_string_to_Poly(taskData, (char*)buff, haveRead)); 612 free(buff); 613 return result; 614 } 615 free(buff); 616 // If it failed because it was interrupted keep trying otherwise it's an error. 617 if (errno != EINTR) 618 raise_syscall(taskData, "Error while reading", ERRORNUMBER); 619 } 620} 621 622static Handle writeArray(TaskData *taskData, Handle stream, Handle args, bool/*isText*/) 623{ 624 /* The isText argument is ignored in both Unix and Windows but 625 is provided for future use. Windows remembers the mode used 626 when the file was opened to determine whether to translate 627 LF into CRLF. */ 628 PolyWord base = DEREFWORDHANDLE(args)->Get(0); 629 POLYUNSIGNED offset = getPolyUnsigned(taskData, DEREFWORDHANDLE(args)->Get(1)); 630#if (defined(_WIN32) && ! defined(__CYGWIN__)) 631 unsigned length = get_C_unsigned(taskData, DEREFWORDHANDLE(args)->Get(2)); 632 int haveWritten; 633#else 634 size_t length = getPolyUnsigned(taskData, DEREFWORDHANDLE(args)->Get(2)); 635 ssize_t haveWritten; 636#endif 637 PIOSTRUCT strm = get_stream(stream->Word()); 638 byte ch; 639 /* Raise an exception if the stream has been closed. */ 640 if (strm == NULL) raise_syscall(taskData, "Stream is closed", STREAMCLOSED); 641 642 /* We don't actually handle cases of blocking on output. */ 643 byte *toWrite; 644 if (IS_INT(base)) 645 { 646 /* To allow this function to work on strings as well as 647 vectors we have to be able to handle the special case of 648 a single character string. */ 649 ch = (byte)(UNTAGGED(base)); 650 toWrite = &ch; 651 offset = 0; 652 length = 1; 653 } 654 else toWrite = base.AsObjPtr()->AsBytePtr(); 655 haveWritten = write(strm->device.ioDesc, toWrite+offset, length); 656 if (haveWritten < 0) raise_syscall(taskData, "Error while writing", ERRORNUMBER); 657 658 return Make_fixed_precision(taskData, haveWritten); 659} 660 661// Test whether we can write without blocking. Returns false if it will block, 662// true if it will not. 663static bool canOutput(TaskData *taskData, Handle stream) 664{ 665 PIOSTRUCT strm = get_stream(stream->Word()); 666 if (strm == NULL) raise_syscall(taskData, "Stream is closed", STREAMCLOSED); 667 668#if (defined(_WIN32) && ! defined(__CYGWIN__)) 669 /* There's no way I can see of doing this in Windows. */ 670 return true; 671#else 672 /* Unix - use "select" to find out if output is possible. */ 673#ifdef __CYGWIN__ 674 static struct timeval poll = {0,1}; 675#else 676 static struct timeval poll = {0,0}; 677#endif 678 fd_set read_fds, write_fds, except_fds; 679 int sel; 680 FD_ZERO(&read_fds); 681 FD_ZERO(&write_fds); 682 FD_ZERO(&except_fds); 683 FD_SET(strm->device.ioDesc, &write_fds); 684 sel = select(FD_SETSIZE,&read_fds,&write_fds,&except_fds,&poll); 685 if (sel < 0 && errno != EINTR) 686 raise_syscall(taskData, "select failed", ERRORNUMBER); 687 return sel > 0; 688#endif 689} 690 691static long seekStream(TaskData *taskData, PIOSTRUCT strm, long pos, int origin) 692{ 693 long lpos; 694 lpos = lseek(strm->device.ioDesc, pos, origin); 695 if (lpos < 0) raise_syscall(taskData, "Position error", ERRORNUMBER); 696 return lpos; 697} 698 699/* Return the number of bytes available on the device. Works only for 700 files since it is meaningless for other devices. */ 701static Handle bytesAvailable(TaskData *taskData, Handle stream) 702{ 703 PIOSTRUCT strm = get_stream(stream->Word()); 704 if (strm == NULL) raise_syscall(taskData, "Stream is closed", STREAMCLOSED); 705 706 /* Remember our original position, seek to the end, then seek back. */ 707 long original = seekStream(taskData, strm, 0L, SEEK_CUR); 708 long endOfStream = seekStream(taskData, strm, 0L, SEEK_END); 709 if (seekStream(taskData, strm, original, SEEK_SET) != original) 710 raise_syscall(taskData, "Position error", ERRORNUMBER); 711 return Make_fixed_precision(taskData, endOfStream-original); 712} 713 714 715#define FILEKIND_FILE 0 716#define FILEKIND_DIR 1 717#define FILEKIND_LINK 2 718#define FILEKIND_TTY 3 719#define FILEKIND_PIPE 4 720#define FILEKIND_SKT 5 721#define FILEKIND_DEV 6 722#define FILEKIND_ERROR (-1) 723 724static Handle fileKind(TaskData *taskData, Handle stream) 725{ 726 PIOSTRUCT strm = get_stream(stream->Word()); 727 if (strm == NULL) raise_syscall(taskData, "Stream is closed", STREAMCLOSED); 728#if (defined(_WIN32) && ! defined(__CYGWIN__)) 729 { 730 HANDLE hTest; 731 if (strm->device.ioDesc == 0) 732 { 733 // Stdin is special. The actual handle is to a pipe whether we are using our 734 // own console or we were provided with a stdin. 735 if (hOldStdin == INVALID_HANDLE_VALUE) 736 return Make_fixed_precision(taskData, FILEKIND_TTY); // We've made our own console 737 hTest = hOldStdin; 738 } 739 else hTest = (HANDLE)_get_osfhandle(strm->device.ioDesc); 740 switch (GetFileType(hTest)) 741 { 742 case FILE_TYPE_PIPE: return Make_fixed_precision(taskData, FILEKIND_PIPE); 743 case FILE_TYPE_CHAR: return Make_fixed_precision(taskData, FILEKIND_TTY); // Or a device? 744 default: return Make_fixed_precision(taskData, FILEKIND_FILE); 745 } 746 } 747#else 748 { 749 struct stat statBuff; 750 if (fstat(strm->device.ioDesc, &statBuff) < 0) raise_syscall(taskData, "Stat failed", ERRORNUMBER); 751 switch (statBuff.st_mode & S_IFMT) 752 { 753 case S_IFIFO: 754 return Make_fixed_precision(taskData, FILEKIND_PIPE); 755 case S_IFCHR: 756 case S_IFBLK: 757 if (isatty(strm->device.ioDesc)) 758 return Make_fixed_precision(taskData, FILEKIND_TTY); 759 else return Make_fixed_precision(taskData, FILEKIND_DEV); 760 case S_IFDIR: 761 return Make_fixed_precision(taskData, FILEKIND_DIR); 762 case S_IFREG: 763 return Make_fixed_precision(taskData, FILEKIND_FILE); 764 case S_IFLNK: 765 return Make_fixed_precision(taskData, FILEKIND_LINK); 766 case S_IFSOCK: 767 return Make_fixed_precision(taskData, FILEKIND_SKT); 768 default: 769 return Make_fixed_precision(taskData, -1); 770 } 771 } 772#endif 773} 774 775/* Polling. For the moment this applies only to objects which can 776 be opened in the file system. It may need to be extended to sockets 777 later. */ 778#define POLL_BIT_IN 1 779#define POLL_BIT_OUT 2 780#define POLL_BIT_PRI 4 781/* Find out what polling options, if any, are allowed on this 782 file descriptor. We assume that polling is allowed on all 783 descriptors, either for reading or writing depending on how 784 the stream was opened. */ 785Handle pollTest(TaskData *taskData, Handle stream) 786{ 787 PIOSTRUCT strm = get_stream(stream->Word()); 788 int nRes = 0; 789 if (strm == NULL) return Make_fixed_precision(taskData, 0); 790 /* Allow for the possibility of both being set in the future. */ 791 if (isRead(strm)) nRes |= POLL_BIT_IN; 792 if (isWrite(strm)) nRes |= POLL_BIT_OUT; 793 /* For the moment we don't allow POLL_BIT_PRI. */ 794 return Make_fixed_precision(taskData, nRes); 795} 796 797/* Do the polling. Takes a vector of io descriptors, a vector of bits to test 798 and a time to wait and returns a vector of results. */ 799static Handle pollDescriptors(TaskData *taskData, Handle args, int blockType) 800{ 801 TryAgain: 802 PolyObject *strmVec = DEREFHANDLE(args)->Get(0).AsObjPtr(); 803 PolyObject *bitVec = DEREFHANDLE(args)->Get(1).AsObjPtr(); 804 POLYUNSIGNED nDesc = strmVec->Length(); 805 ASSERT(nDesc == bitVec->Length()); 806 // We should check for interrupts even if we're not going to block. 807 processes->TestAnyEvents(taskData); 808 809 /* Simply do a non-blocking poll. */ 810#if (defined(_WIN32) && ! defined(__CYGWIN__)) 811 { 812 /* Record the results in this vector. */ 813 char *results = 0; 814 int haveResult = 0; 815 Handle resVec; 816 if (nDesc > 0) 817 { 818 results = (char*)alloca(nDesc); 819 memset(results, 0, nDesc); 820 } 821 822 for (POLYUNSIGNED i = 0; i < nDesc; i++) 823 { 824 Handle marker = taskData->saveVec.mark(); 825 PIOSTRUCT strm = get_stream(strmVec->Get(i)); 826 taskData->saveVec.reset(marker); 827 int bits = get_C_int(taskData, bitVec->Get(i)); 828 if (strm == NULL) raise_syscall(taskData, "Stream is closed", STREAMCLOSED); 829 830 if (isSocket(strm)) 831 { 832 SOCKET sock = strm->device.sock; 833 if (bits & POLL_BIT_PRI) 834 { 835 u_long atMark = 0; 836 ioctlsocket(sock, SIOCATMARK, &atMark); 837 if (atMark) { haveResult = 1; results[i] |= POLL_BIT_PRI; } 838 } 839 if (bits & (POLL_BIT_IN|POLL_BIT_OUT)) 840 { 841 FD_SET readFds, writeFds; 842 TIMEVAL poll = {0, 0}; 843 FD_ZERO(&readFds); FD_ZERO(&writeFds); 844 if (bits & POLL_BIT_IN) FD_SET(sock, &readFds); 845 if (bits & POLL_BIT_OUT) FD_SET(sock, &writeFds); 846 if (select(FD_SETSIZE, &readFds, &writeFds, NULL, &poll) > 0) 847 { 848 haveResult = 1; 849 /* N.B. select only tells us about out-of-band data if 850 SO_OOBINLINE is FALSE. */ 851 if (FD_ISSET(sock, &readFds)) results[i] |= POLL_BIT_IN; 852 if (FD_ISSET(sock, &writeFds)) results[i] |= POLL_BIT_OUT; 853 } 854 } 855 } 856 else 857 { 858 if ((bits & POLL_BIT_IN) && isRead(strm) && isAvailable(taskData, strm)) 859 { 860 haveResult = 1; 861 results[i] |= POLL_BIT_IN; 862 } 863 if ((bits & POLL_BIT_OUT) && isWrite(strm)) 864 { 865 /* I don't know if there's any way to do this. */ 866 if (WaitForSingleObject( 867 (HANDLE)_get_osfhandle(strm->device.ioDesc), 0) == WAIT_OBJECT_0) 868 { 869 haveResult = 1; 870 results[i] |= POLL_BIT_OUT; 871 } 872 } 873 /* PRIORITY doesn't make sense for anything but a socket. */ 874 } 875 } 876 if (haveResult == 0) 877 { 878 /* Poll failed - treat as time out. */ 879 switch (blockType) 880 { 881 case 0: /* Check the time out. */ 882 { 883 Handle hSave = taskData->saveVec.mark(); 884 /* The time argument is an absolute time. */ 885 FILETIME ftTime, ftNow; 886 /* Get the file time. */ 887 getFileTimeFromArb(taskData, taskData->saveVec.push(DEREFHANDLE(args)->Get(2)), &ftTime); 888 GetSystemTimeAsFileTime(&ftNow); 889 taskData->saveVec.reset(hSave); 890 /* If the timeout time is earlier than the current time 891 we must return, otherwise we block. */ 892 if (CompareFileTime(&ftTime, &ftNow) <= 0) 893 break; /* Return the empty set. */ 894 /* else drop through and block. */ 895 } 896 case 1: /* Block until one of the descriptors is ready. */ 897 processes->ThreadPause(taskData); 898 goto TryAgain; 899 /*NOTREACHED*/ 900 case 2: /* Just a simple poll - drop through. */ 901 break; 902 } 903 } 904 /* Copy the results to a result vector. */ 905 resVec = alloc_and_save(taskData, nDesc); 906 for (POLYUNSIGNED j = 0; j < nDesc; j++) 907 (DEREFWORDHANDLE(resVec))->Set(j, TAGGED(results[j])); 908 return resVec; 909 } 910#elif (! defined(HAVE_POLL_H)) 911 /* Unix but poll isn't provided, e.g. Mac OS X. Implement in terms of "select" as far as we can. */ 912 { 913 fd_set readFds, writeFds, exceptFds; 914 struct timeval poll = {0, 0}; 915 int selectRes = 0; 916 FD_ZERO(&readFds); FD_ZERO(&writeFds); FD_ZERO(&exceptFds); 917 918 for (POLYUNSIGNED i = 0; i < nDesc; i++) 919 { 920 PIOSTRUCT strm = get_stream(strmVec->Get(i)); 921 int bits = UNTAGGED(bitVec->Get(i)); 922 if (strm == NULL) raise_syscall(taskData, "Stream is closed", STREAMCLOSED); 923 if (bits & POLL_BIT_IN) FD_SET(strm->device.ioDesc, &readFds); 924 if (bits & POLL_BIT_OUT) FD_SET(strm->device.ioDesc, &writeFds); 925 } 926 /* Simply check the status without blocking. */ 927 if (nDesc > 0) selectRes = select(FD_SETSIZE, &readFds, &writeFds, &exceptFds, &poll); 928 if (selectRes < 0) raise_syscall(taskData, "select failed", ERRORNUMBER); 929 /* What if nothing was ready? */ 930 if (selectRes == 0) 931 { 932 switch (blockType) 933 { 934 case 0: /* Check the timeout. */ 935 { 936 struct timeval tv; 937 /* We have a value in microseconds. We need to split 938 it into seconds and microseconds. */ 939 Handle hSave = taskData->saveVec.mark(); 940 Handle hTime = SAVE(DEREFWORDHANDLE(args)->Get(2)); 941 Handle hMillion = Make_arbitrary_precision(taskData, 1000000); 942 unsigned long secs = 943 get_C_ulong(taskData, DEREFWORD(div_longc(taskData, hMillion, hTime))); 944 unsigned long usecs = 945 get_C_ulong(taskData, DEREFWORD(rem_longc(taskData, hMillion, hTime))); 946 /* If the timeout time is earlier than the current time 947 we must return, otherwise we block. */ 948 taskData->saveVec.reset(hSave); 949 if (gettimeofday(&tv, NULL) != 0) 950 raise_syscall(taskData, "gettimeofday failed", ERRORNUMBER); 951 if ((unsigned long)tv.tv_sec > secs || 952 ((unsigned long)tv.tv_sec == secs && (unsigned long)tv.tv_usec >= usecs)) 953 break; 954 /* else block. */ 955 } 956 case 1: /* Block until one of the descriptors is ready. */ 957 processes->ThreadPause(taskData); 958 goto TryAgain; 959 case 2: /* Just a simple poll - drop through. */ 960 break; 961 } 962 } 963 /* Copy the results. */ 964 if (nDesc == 0) return taskData->saveVec.push(EmptyString()); 965 /* Construct a result vector. */ 966 Handle resVec = alloc_and_save(taskData, nDesc); 967 for (POLYUNSIGNED i = 0; i < nDesc; i++) 968 { 969 POLYUNSIGNED res = 0; 970 POLYUNSIGNED bits = UNTAGGED(bitVec->Get(i)); 971 PIOSTRUCT strm = get_stream(strmVec->Get(i).AsObjPtr()); 972 if ((bits & POLL_BIT_IN) && FD_ISSET(strm->device.ioDesc, &readFds)) res |= POLL_BIT_IN; 973 if ((bits & POLL_BIT_OUT) && FD_ISSET(strm->device.ioDesc, &writeFds)) res |= POLL_BIT_OUT; 974 DEREFWORDHANDLE(resVec)->Set(i, TAGGED(res)); 975 } 976 return resVec; 977 } 978#else 979 /* Unix */ 980 { 981 int pollRes = 0; 982 struct pollfd * fds = 0; 983 if (nDesc > 0) 984 fds = (struct pollfd *)alloca(nDesc * sizeof(struct pollfd)); 985 986 /* Set up the request vector. */ 987 for (unsigned i = 0; i < nDesc; i++) 988 { 989 PIOSTRUCT strm = get_stream(strmVec->Get(i)); 990 POLYUNSIGNED bits = UNTAGGED(bitVec->Get(i)); 991 if (strm == NULL) raise_syscall(taskData, "Stream is closed", STREAMCLOSED); 992 fds[i].fd = strm->device.ioDesc; 993 fds[i].events = 0; 994 if (bits & POLL_BIT_IN) fds[i].events |= POLLIN; /* | POLLRDNORM??*/ 995 if (bits & POLL_BIT_OUT) fds[i].events |= POLLOUT; 996 if (bits & POLL_BIT_PRI) fds[i].events |= POLLPRI; 997 fds[i].revents = 0; 998 } 999 /* Poll the descriptors. */ 1000 if (nDesc > 0) pollRes = poll(fds, nDesc, 0); 1001 if (pollRes < 0) raise_syscall(taskData, "poll failed", ERRORNUMBER); 1002 /* What if nothing was ready? */ 1003 if (pollRes == 0) 1004 { 1005 switch (blockType) 1006 { 1007 case 0: /* Check the timeout. */ 1008 { 1009 struct timeval tv; 1010 /* We have a value in microseconds. We need to split 1011 it into seconds and microseconds. */ 1012 // We need to reset the savevec because we can come here repeatedly 1013 Handle hSave = taskData->saveVec.mark(); 1014 Handle hTime = SAVE(DEREFWORDHANDLE(args)->Get(2)); 1015 Handle hMillion = Make_arbitrary_precision(taskData, 1000000); 1016 unsigned long secs = 1017 get_C_ulong(taskData, DEREFWORD(div_longc(taskData, hMillion, hTime))); 1018 unsigned long usecs = 1019 get_C_ulong(taskData, DEREFWORD(rem_longc(taskData, hMillion, hTime))); 1020 taskData->saveVec.reset(hSave); 1021 /* If the timeout time is earlier than the current time 1022 we must return, otherwise we block. */ 1023 if (gettimeofday(&tv, NULL) != 0) 1024 raise_syscall(taskData, "gettimeofday failed", ERRORNUMBER); 1025 if ((unsigned long)tv.tv_sec > secs || 1026 ((unsigned long)tv.tv_sec == secs && (unsigned long)tv.tv_usec >= usecs)) 1027 break; 1028 /* else block. */ 1029 } 1030 case 1: /* Block until one of the descriptors is ready. */ 1031 processes->ThreadPause(taskData); 1032 goto TryAgain; 1033 case 2: /* Just a simple poll - drop through. */ 1034 break; 1035 } 1036 } 1037 /* Copy the results. */ 1038 /* Construct a result vector. */ 1039 Handle resVec = alloc_and_save(taskData, nDesc); 1040 for (unsigned i = 0; i < nDesc; i++) 1041 { 1042 int res = 0; 1043 if (fds[i].revents & POLLIN) res = POLL_BIT_IN; 1044 if (fds[i].revents & POLLOUT) res = POLL_BIT_OUT; 1045 if (fds[i].revents & POLLPRI) res = POLL_BIT_PRI; 1046 DEREFWORDHANDLE(resVec)->Set(i, TAGGED(res)); 1047 } 1048 return resVec; 1049 } 1050#endif 1051} 1052 1053 1054/* Directory functions. */ 1055/* Open a directory. */ 1056static Handle openDirectory(TaskData *taskData, Handle dirname) 1057{ 1058 while (1) // Only certain errors 1059 { 1060 Handle str_token = make_stream_entry(taskData); 1061 if (str_token == NULL) raise_syscall(taskData, "Insufficient memory", NOMEMORY); 1062 POLYUNSIGNED stream_no = STREAMID(str_token); 1063 PIOSTRUCT strm = &basic_io_vector[stream_no]; 1064#if (defined(_WIN32) && ! defined(__CYGWIN__)) 1065 { 1066 // Get the directory name but add on two characters for the \* plus one for the NULL. 1067 POLYUNSIGNED length = PolyStringLength(dirname->Word()); 1068 TempString dirName((TCHAR*)malloc((length + 3)*sizeof(TCHAR))); 1069 if (dirName == 0) raise_syscall(taskData, "Insufficient memory", NOMEMORY); 1070 Poly_string_to_C(dirname->Word(), dirName, length+2); 1071 // Tack on \* to the end so that we find all files in the directory. 1072 lstrcat(dirName, _T("\\*")); 1073 HANDLE hFind = FindFirstFile(dirName, &strm->device.directory.lastFind); 1074 if (hFind == INVALID_HANDLE_VALUE) 1075 raise_syscall(taskData, "FindFirstFile failed", GetLastError()); 1076 strm->device.directory.hFind = hFind; 1077 /* There must be at least one file which matched. */ 1078 strm->device.directory.fFindSucceeded = 1; 1079 } 1080#else 1081 TempString dirName(dirname->Word()); 1082 if (dirName == 0) raise_syscall(taskData, "Insufficient memory", NOMEMORY); 1083 DIR *dirp = opendir(dirName); 1084 if (dirp == NULL) 1085 { 1086 free_stream_entry(stream_no); 1087 switch (errno) 1088 { 1089 case EINTR: 1090 continue; // Just retry the call. 1091 case EMFILE: 1092 { 1093 if (emfileFlag) /* Previously had an EMFILE error. */ 1094 raise_syscall(taskData, "Cannot open", TOOMANYFILES); 1095 emfileFlag = true; 1096 FullGC(taskData); /* May clear emfileFlag if we close a file. */ 1097 continue; 1098 } 1099 default: 1100 raise_syscall(taskData, "opendir failed", ERRORNUMBER); 1101 } 1102 } 1103 strm->device.ioDir = dirp; 1104#endif 1105 strm->ioBits = IO_BIT_OPEN | IO_BIT_DIR; 1106 return(str_token); 1107 } 1108} 1109 1110/* Return the next entry from the directory, ignoring current and 1111 parent arcs ("." and ".." in Windows and Unix) */ 1112Handle readDirectory(TaskData *taskData, Handle stream) 1113{ 1114 PIOSTRUCT strm = get_stream(stream->Word()); 1115#if (defined(_WIN32) && ! defined(__CYGWIN__)) 1116 Handle result = NULL; 1117#endif 1118 /* Raise an exception if the stream has been closed. */ 1119 if (strm == NULL) raise_syscall(taskData, "Stream is closed", STREAMCLOSED); 1120#if (defined(_WIN32) && ! defined(__CYGWIN__)) 1121 /* The next entry to read is already in the buffer. FindFirstFile 1122 both opens the directory and returns the first entry. If 1123 fFindSucceeded is false we have already reached the end. */ 1124 if (! strm->device.directory.fFindSucceeded) 1125 return SAVE(EmptyString(taskData)); 1126 while (result == NULL) 1127 { 1128 WIN32_FIND_DATA *pFind = &strm->device.directory.lastFind; 1129 if (!((pFind->dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) && 1130 (lstrcmp(pFind->cFileName, _T(".")) == 0 || 1131 lstrcmp(pFind->cFileName, _T("..")) == 0))) 1132 { 1133 result = SAVE(C_string_to_Poly(taskData, pFind->cFileName)); 1134 } 1135 /* Get the next entry. */ 1136 if (! FindNextFile(strm->device.directory.hFind, pFind)) 1137 { 1138 DWORD dwErr = GetLastError(); 1139 if (dwErr == ERROR_NO_MORE_FILES) 1140 { 1141 strm->device.directory.fFindSucceeded = 0; 1142 if (result == NULL) return SAVE(EmptyString(taskData)); 1143 } 1144 } 1145 } 1146 return result; 1147#else 1148 while (1) 1149 { 1150 struct dirent *dp = readdir(strm->device.ioDir); 1151 int len; 1152 if (dp == NULL) return taskData->saveVec.push(EmptyString(taskData)); 1153 len = NAMLEN(dp); 1154 if (!((len == 1 && strncmp(dp->d_name, ".", 1) == 0) || 1155 (len == 2 && strncmp(dp->d_name, "..", 2) == 0))) 1156 return SAVE(C_string_to_Poly(taskData, dp->d_name, len)); 1157 } 1158#endif 1159} 1160 1161Handle rewindDirectory(TaskData *taskData, Handle stream, Handle dirname) 1162{ 1163 PIOSTRUCT strm = get_stream(stream->Word()); 1164 /* Raise an exception if the stream has been closed. */ 1165 if (strm == NULL) raise_syscall(taskData, "Stream is closed", STREAMCLOSED); 1166#if (defined(_WIN32) && ! defined(__CYGWIN__)) 1167 { 1168 /* There's no rewind - close and reopen. */ 1169 FindClose(strm->device.directory.hFind); 1170 strm->ioBits = 0; 1171 POLYUNSIGNED length = PolyStringLength(dirname->Word()); 1172 TempString dirName((TCHAR*)malloc((length + 3)*sizeof(TCHAR))); 1173 if (dirName == 0) raise_syscall(taskData, "Insufficient memory", NOMEMORY); 1174 Poly_string_to_C(dirname->Word(), dirName, length+2); 1175 // Tack on \* to the end so that we find all files in the directory. 1176 lstrcat(dirName, _T("\\*")); 1177 HANDLE hFind = FindFirstFile(dirName, &strm->device.directory.lastFind); 1178 if (hFind == INVALID_HANDLE_VALUE) 1179 raise_syscall(taskData, "FindFirstFile failed", GetLastError()); 1180 strm->device.directory.hFind = hFind; 1181 /* There must be at least one file which matched. */ 1182 strm->device.directory.fFindSucceeded = 1; 1183 strm->ioBits = IO_BIT_OPEN | IO_BIT_DIR; 1184 } 1185#else 1186 rewinddir(strm->device.ioDir); 1187#endif 1188 return Make_fixed_precision(taskData, 0); 1189} 1190 1191/* change_dirc - this is called directly and not via the dispatch 1192 function. */ 1193static Handle change_dirc(TaskData *taskData, Handle name) 1194/* Change working directory. */ 1195{ 1196 TempString cDirName(name->Word()); 1197 if (cDirName == 0) raise_syscall(taskData, "Insufficient memory", NOMEMORY); 1198#if (defined(_WIN32) && ! defined(__CYGWIN__)) 1199 if (SetCurrentDirectory(cDirName) == FALSE) 1200 raise_syscall(taskData, "SetCurrentDirectory failed", GetLastError()); 1201#else 1202 if (chdir(cDirName) != 0) 1203 raise_syscall(taskData, "chdir failed", ERRORNUMBER); 1204#endif 1205 return SAVE(TAGGED(0)); 1206} 1207 1208// External call 1209POLYUNSIGNED PolyChDir(PolyObject *threadId, PolyWord arg) 1210{ 1211 TaskData *taskData = TaskData::FindTaskForId(threadId); 1212 ASSERT(taskData != 0); 1213 taskData->PreRTSCall(); 1214 Handle reset = taskData->saveVec.mark(); 1215 Handle pushedArg = taskData->saveVec.push(arg); 1216 1217 try { 1218 (void)change_dirc(taskData, pushedArg); 1219 } catch (...) { } // If an ML exception is raised 1220 1221 taskData->saveVec.reset(reset); // Ensure the save vec is reset 1222 taskData->PostRTSCall(); 1223 return TAGGED(0).AsUnsigned(); // Result is unit 1224} 1225 1226 1227/* Test for a directory. */ 1228Handle isDir(TaskData *taskData, Handle name) 1229{ 1230 TempString cDirName(name->Word()); 1231 if (cDirName == 0) raise_syscall(taskData, "Insufficient memory", NOMEMORY); 1232#if (defined(_WIN32) && ! defined(__CYGWIN__)) 1233 { 1234 DWORD dwRes = GetFileAttributes(cDirName); 1235 if (dwRes == 0xFFFFFFFF) 1236 raise_syscall(taskData, "GetFileAttributes failed", GetLastError()); 1237 if (dwRes & FILE_ATTRIBUTE_DIRECTORY) 1238 return Make_fixed_precision(taskData, 1); 1239 else return Make_fixed_precision(taskData, 0); 1240 } 1241#else 1242 { 1243 struct stat fbuff; 1244 if (stat(cDirName, &fbuff) != 0) 1245 raise_syscall(taskData, "stat failed", ERRORNUMBER); 1246 if ((fbuff.st_mode & S_IFMT) == S_IFDIR) 1247 return Make_fixed_precision(taskData, 1); 1248 else return Make_fixed_precision(taskData, 0); 1249 } 1250#endif 1251} 1252 1253/* Get absolute canonical path name. */ 1254Handle fullPath(TaskData *taskData, Handle filename) 1255{ 1256 TempString cFileName; 1257 1258 /* Special case of an empty string. */ 1259 if (PolyStringLength(filename->Word()) == 0) cFileName = _tcsdup(_T(".")); 1260 else cFileName = Poly_string_to_T_alloc(filename->Word()); 1261 if (cFileName == 0) raise_syscall(taskData, "Insufficient memory", NOMEMORY); 1262 1263#if (defined(_WIN32) && ! defined(__CYGWIN__)) 1264 { 1265 // Get the length 1266 DWORD dwRes = GetFullPathName(cFileName, 0, NULL, NULL); 1267 if (dwRes == 0) 1268 raise_syscall(taskData, "GetFullPathName failed", GetLastError()); 1269 TempString resBuf((TCHAR*)malloc(dwRes * sizeof(TCHAR))); 1270 if (resBuf == 0) raise_syscall(taskData, "Insufficient memory", NOMEMORY); 1271 // When the length is enough the result is the length excluding the null 1272 DWORD dwRes1 = GetFullPathName(cFileName, dwRes, resBuf, NULL); 1273 if (dwRes1 == 0 || dwRes1 >= dwRes) 1274 raise_syscall(taskData, "GetFullPathName failed", GetLastError()); 1275 /* Check that the file exists. GetFullPathName doesn't do that. */ 1276 dwRes = GetFileAttributes(resBuf); 1277 if (dwRes == 0xffffffff) 1278 raise_syscall(taskData, "File does not exist", FILEDOESNOTEXIST); 1279 return(SAVE(C_string_to_Poly(taskData, resBuf))); 1280 } 1281#else 1282 { 1283 TempCString resBuf(realpath(cFileName, NULL)); 1284 if (resBuf == NULL) 1285 raise_syscall(taskData, "realpath failed", ERRORNUMBER); 1286 /* Some versions of Unix don't check the final component 1287 of a file. To be consistent try doing a "stat" of 1288 the resulting string to check it exists. */ 1289 struct stat fbuff; 1290 if (stat(resBuf, &fbuff) != 0) 1291 raise_syscall(taskData, "stat failed", ERRORNUMBER); 1292 return(SAVE(C_string_to_Poly(taskData, resBuf))); 1293 } 1294#endif 1295} 1296 1297/* Get file modification time. This returns the value in the 1298 time units and from the base date used by timing.c. c.f. filedatec */ 1299Handle modTime(TaskData *taskData, Handle filename) 1300{ 1301 TempString cFileName(filename->Word()); 1302 if (cFileName == 0) raise_syscall(taskData, "Insufficient memory", NOMEMORY); 1303#if (defined(_WIN32) && ! defined(__CYGWIN__)) 1304 { 1305 /* There are two ways to get this information. 1306 We can either use GetFileTime if we are able 1307 to open the file for reading but if it is locked 1308 we won't be able to. FindFirstFile is the other 1309 alternative. We have to check that the file name 1310 does not contain '*' or '?' otherwise it will try 1311 to "glob" this, which isn't what we want here. */ 1312 WIN32_FIND_DATA wFind; 1313 HANDLE hFind; 1314 const TCHAR *p; 1315 for(p = cFileName; *p; p++) 1316 if (*p == '*' || *p == '?') 1317 raise_syscall(taskData, "Invalid filename", STREAMCLOSED); 1318 hFind = FindFirstFile(cFileName, &wFind); 1319 if (hFind == INVALID_HANDLE_VALUE) 1320 raise_syscall(taskData, "FindFirstFile failed", GetLastError()); 1321 FindClose(hFind); 1322 return Make_arb_from_Filetime(taskData, wFind.ftLastWriteTime); 1323 } 1324#else 1325 { 1326 struct stat fbuff; 1327 if (stat(cFileName, &fbuff) != 0) 1328 raise_syscall(taskData, "stat failed", ERRORNUMBER); 1329 /* Convert to microseconds. */ 1330 return Make_arb_from_pair_scaled(taskData, STAT_SECS(&fbuff,m), 1331 STAT_USECS(&fbuff,m), 1000000); 1332 } 1333#endif 1334} 1335 1336/* Get file size. */ 1337Handle fileSize(TaskData *taskData, Handle filename) 1338{ 1339 TempString cFileName(filename->Word()); 1340 if (cFileName == 0) raise_syscall(taskData, "Insufficient memory", NOMEMORY); 1341#if (defined(_WIN32) && ! defined(__CYGWIN__)) 1342 { 1343 /* Similar to modTime*/ 1344 WIN32_FIND_DATA wFind; 1345 HANDLE hFind; 1346 const TCHAR *p; 1347 for(p = cFileName; *p; p++) 1348 if (*p == '*' || *p == '?') 1349 raise_syscall(taskData, "Invalid filename", STREAMCLOSED); 1350 hFind = FindFirstFile(cFileName, &wFind); 1351 if (hFind == INVALID_HANDLE_VALUE) 1352 raise_syscall(taskData, "FindFirstFile failed", GetLastError()); 1353 FindClose(hFind); 1354 return Make_arb_from_32bit_pair(taskData, wFind.nFileSizeHigh, wFind.nFileSizeLow); 1355 } 1356#else 1357 { 1358 struct stat fbuff; 1359 if (stat(cFileName, &fbuff) != 0) 1360 raise_syscall(taskData, "stat failed", ERRORNUMBER); 1361 return Make_arbitrary_precision(taskData, fbuff.st_size); 1362 } 1363#endif 1364} 1365 1366/* Set file modification and access times. */ 1367Handle setTime(TaskData *taskData, Handle fileName, Handle fileTime) 1368{ 1369 TempString cFileName(fileName->Word()); 1370 if (cFileName == 0) raise_syscall(taskData, "Insufficient memory", NOMEMORY); 1371 1372#if (defined(_WIN32) && ! defined(__CYGWIN__)) 1373 /* The only way to set the time is to open the file and 1374 use SetFileTime. */ 1375 { 1376 FILETIME ft; 1377 /* Get the file time. */ 1378 getFileTimeFromArb(taskData, fileTime, &ft); 1379 /* Open an existing file with write access. We need that 1380 for SetFileTime. */ 1381 HANDLE hFile = CreateFile(cFileName, GENERIC_WRITE, 0, NULL, OPEN_EXISTING, 1382 FILE_ATTRIBUTE_NORMAL, NULL); 1383 if (hFile == INVALID_HANDLE_VALUE) 1384 raise_syscall(taskData, "CreateFile failed", GetLastError()); 1385 /* Set the file time. */ 1386 if (!SetFileTime(hFile, NULL, &ft, &ft)) 1387 { 1388 int nErr = GetLastError(); 1389 CloseHandle(hFile); 1390 raise_syscall(taskData, "SetFileTime failed", nErr); 1391 } 1392 CloseHandle(hFile); 1393 } 1394#else 1395 { 1396 struct timeval times[2]; 1397 /* We have a value in microseconds. We need to split 1398 it into seconds and microseconds. */ 1399 Handle hTime = fileTime; 1400 Handle hMillion = Make_arbitrary_precision(taskData, 1000000); 1401 /* N.B. Arguments to div_longc and rem_longc are in reverse order. */ 1402 unsigned secs = 1403 get_C_ulong(taskData, DEREFWORD(div_longc(taskData, hMillion, hTime))); 1404 unsigned usecs = 1405 get_C_ulong(taskData, DEREFWORD(rem_longc(taskData, hMillion, hTime))); 1406 times[0].tv_sec = times[1].tv_sec = secs; 1407 times[0].tv_usec = times[1].tv_usec = usecs; 1408 if (utimes(cFileName, times) != 0) 1409 raise_syscall(taskData, "utimes failed", ERRORNUMBER); 1410 } 1411#endif 1412 return Make_fixed_precision(taskData, 0); 1413} 1414 1415/* Rename a file. */ 1416Handle renameFile(TaskData *taskData, Handle oldFileName, Handle newFileName) 1417{ 1418 TempString oldName(oldFileName->Word()), newName(newFileName->Word()); 1419 if (oldName == 0 || newName == 0) raise_syscall(taskData, "Insufficient memory", NOMEMORY); 1420#if (defined(_WIN32) && ! defined(__CYGWIN__)) 1421 if (! MoveFileEx(oldName, newName, MOVEFILE_REPLACE_EXISTING)) 1422 raise_syscall(taskData, "MoveFileEx failed", GetLastError()); 1423#else 1424 if (rename(oldName, newName) != 0) 1425 raise_syscall(taskData, "rename failed", ERRORNUMBER); 1426#endif 1427 return Make_fixed_precision(taskData, 0); 1428} 1429 1430/* Access right requests passed in from ML. */ 1431#define FILE_ACCESS_READ 1 1432#define FILE_ACCESS_WRITE 2 1433#define FILE_ACCESS_EXECUTE 4 1434 1435/* Get access rights to a file. */ 1436Handle fileAccess(TaskData *taskData, Handle name, Handle rights) 1437{ 1438 TempString fileName(name->Word()); 1439 if (fileName == 0) raise_syscall(taskData, "Insufficient memory", NOMEMORY); 1440 int rts = get_C_int(taskData, DEREFWORD(rights)); 1441 1442#if (defined(_WIN32) && ! defined(__CYGWIN__)) 1443 { 1444 /* Test whether the file is read-only. This is, of course, 1445 not what was asked but getting anything more is really 1446 quite complicated. I don't see how we can find out if 1447 a file is executable (maybe check if the extension is 1448 .exe, .com or .bat?). It would be possible, in NT, to 1449 examine the access structures but that seems far too 1450 complicated. Leave it for the moment. */ 1451 DWORD dwRes = GetFileAttributes(fileName); 1452 if (dwRes == 0xffffffff) 1453 return Make_fixed_precision(taskData, 0); 1454 /* If we asked for write access but it is read-only we 1455 return false. */ 1456 if ((dwRes & FILE_ATTRIBUTE_READONLY) && 1457 (rts & FILE_ACCESS_WRITE)) 1458 return Make_fixed_precision(taskData, 0); 1459 else return Make_fixed_precision(taskData, 1); 1460 } 1461#else 1462 { 1463 int mode = 0; 1464 if (rts & FILE_ACCESS_READ) mode |= R_OK; 1465 if (rts & FILE_ACCESS_WRITE) mode |= W_OK; 1466 if (rts & FILE_ACCESS_EXECUTE) mode |= X_OK; 1467 if (mode == 0) mode = F_OK; 1468 /* Return true if access is allowed, otherwise false 1469 for any other error. */ 1470 if (access(fileName, mode) == 0) 1471 return Make_fixed_precision(taskData, 1); 1472 else return Make_fixed_precision(taskData, 0); 1473 } 1474#endif 1475 1476} 1477 1478 1479 1480/* IO_dispatchc. Called from assembly code module. */ 1481static Handle IO_dispatch_c(TaskData *taskData, Handle args, Handle strm, Handle code) 1482{ 1483 unsigned c = get_C_unsigned(taskData, DEREFWORD(code)); 1484 switch (c) 1485 { 1486 case 0: /* Return standard input */ 1487 return SAVE(basic_io_vector[0].token); 1488 case 1: /* Return standard output */ 1489 return SAVE(basic_io_vector[1].token); 1490 case 2: /* Return standard error */ 1491 return SAVE(basic_io_vector[2].token); 1492 case 3: /* Open file for text input. */ 1493 return open_file(taskData, args, O_RDONLY, 0666, 0); 1494 case 4: /* Open file for binary input. */ 1495 return open_file(taskData, args, O_RDONLY | O_BINARY, 0666, 0); 1496 case 5: /* Open file for text output. */ 1497 return open_file(taskData, args, O_WRONLY | O_CREAT | O_TRUNC, 0666, 0); 1498 case 6: /* Open file for binary output. */ 1499 return open_file(taskData, args, O_WRONLY | O_CREAT | O_TRUNC | O_BINARY, 0666, 0); 1500 case 7: /* Close file */ 1501 return close_file(taskData, strm); 1502 case 8: /* Read text into an array. */ 1503 return readArray(taskData, strm, args, true); 1504 case 9: /* Read binary into an array. */ 1505 return readArray(taskData, strm, args, false); 1506 case 10: /* Get text as a string. */ 1507 return readString(taskData, strm, args, true); 1508 case 11: /* Write from memory into a text file. */ 1509 return writeArray(taskData, strm, args, true); 1510 case 12: /* Write from memory into a binary file. */ 1511 return writeArray(taskData, strm, args, false); 1512 case 13: /* Open text file for appending. */ 1513 /* The IO library definition leaves it open whether this 1514 should use "append mode" or not. */ 1515 return open_file(taskData, args, O_WRONLY | O_CREAT | O_APPEND, 0666, 0); 1516 case 14: /* Open binary file for appending. */ 1517 return open_file(taskData, args, O_WRONLY | O_CREAT | O_APPEND | O_BINARY, 0666, 0); 1518 case 15: /* Return recommended buffer size. */ 1519 /* TODO: This should try to find a sensible number based on 1520 the stream handle passed in. Leave it at 1k for 1521 the moment. */ 1522 /* Try increasing to 4k. */ 1523 return Make_fixed_precision(taskData, /*1024*/4096); 1524 1525 case 16: /* See if we can get some input. */ 1526 { 1527 PIOSTRUCT str = get_stream(strm->Word()); 1528 if (str == NULL) raise_syscall(taskData, "Stream is closed", STREAMCLOSED); 1529 return Make_fixed_precision(taskData, isAvailable(taskData, str) ? 1 : 0); 1530 } 1531 1532 case 17: /* Return the number of bytes available. */ 1533 return bytesAvailable(taskData, strm); 1534 1535 case 18: /* Get position on stream. */ 1536 { 1537 /* Get the current position in the stream. This is used to test 1538 for the availability of random access so it should raise an 1539 exception if setFilePos or endFilePos would fail. */ 1540 PIOSTRUCT str = get_stream(strm->Word()); 1541 if (str == NULL) raise_syscall(taskData, "Stream is closed", STREAMCLOSED); 1542 1543 long pos = seekStream(taskData, str, 0L, SEEK_CUR); 1544 return Make_arbitrary_precision(taskData, pos); 1545 } 1546 1547 case 19: /* Seek to position on stream. */ 1548 { 1549 long position = (long)get_C_long(taskData, DEREFWORD(args)); 1550 PIOSTRUCT str = get_stream(strm->Word()); 1551 if (str == NULL) raise_syscall(taskData, "Stream is closed", STREAMCLOSED); 1552 1553 (void)seekStream(taskData, str, position, SEEK_SET); 1554 return Make_arbitrary_precision(taskData, 0); 1555 } 1556 1557 case 20: /* Return position at end of stream. */ 1558 { 1559 PIOSTRUCT str = get_stream(strm->Word()); 1560 if (str == NULL) raise_syscall(taskData, "Stream is closed", STREAMCLOSED); 1561 1562 /* Remember our original position, seek to the end, then seek back. */ 1563 long original = seekStream(taskData, str, 0L, SEEK_CUR); 1564 long endOfStream = seekStream(taskData, str, 0L, SEEK_END); 1565 if (seekStream(taskData, str, original, SEEK_SET) != original) 1566 raise_syscall(taskData, "Position error", ERRORNUMBER); 1567 return Make_arbitrary_precision(taskData, endOfStream); 1568 } 1569 1570 case 21: /* Get the kind of device underlying the stream. */ 1571 return fileKind(taskData, strm); 1572 case 22: /* Return the polling options allowed on this descriptor. */ 1573 return pollTest(taskData, strm); 1574 case 23: /* Poll the descriptor, waiting forever. */ 1575 return pollDescriptors(taskData, args, 1); 1576 case 24: /* Poll the descriptor, waiting for the time requested. */ 1577 return pollDescriptors(taskData, args, 0); 1578 case 25: /* Poll the descriptor, returning immediately.*/ 1579 return pollDescriptors(taskData, args, 2); 1580 case 26: /* Get binary as a vector. */ 1581 return readString(taskData, strm, args, false); 1582 1583 case 27: /* Block until input is available. */ 1584 // We should check for interrupts even if we're not going to block. 1585 processes->TestAnyEvents(taskData); 1586 while (true) { 1587 PIOSTRUCT str = get_stream(strm->Word()); 1588 if (str == NULL) raise_syscall(taskData, "Stream is closed", STREAMCLOSED); 1589 if (isAvailable(taskData, str)) 1590 return Make_fixed_precision(taskData, 0); 1591 WaitStream waiter(str); 1592 processes->ThreadPauseForIO(taskData, &waiter); 1593 } 1594 1595 case 28: /* Test whether output is possible. */ 1596 return Make_fixed_precision(taskData, canOutput(taskData, strm) ? 1:0); 1597 1598 case 29: /* Block until output is possible. */ 1599 // We should check for interrupts even if we're not going to block. 1600 processes->TestAnyEvents(taskData); 1601 while (true) { 1602 if (canOutput(taskData, strm)) 1603 return Make_fixed_precision(taskData, 0); 1604 // Use the default waiter for the moment since we don't have 1605 // one to test for output. 1606 processes->ThreadPauseForIO(taskData, Waiter::defaultWaiter); 1607 } 1608 1609 /* Functions added for Posix structure. */ 1610 case 30: /* Return underlying file descriptor. */ 1611 /* This is now also used internally to test for 1612 stdIn, stdOut and stdErr. */ 1613 { 1614 PIOSTRUCT str = get_stream(strm->Word()); 1615 if (str == NULL) raise_syscall(taskData, "Stream is closed", STREAMCLOSED); 1616 return Make_fixed_precision(taskData, str->device.ioDesc); 1617 } 1618 1619 case 31: /* Make an entry for a given descriptor. */ 1620 { 1621 int ioDesc = get_C_int(taskData, DEREFWORD(args)); 1622 PIOSTRUCT str; 1623 /* First see if it's already in the table. */ 1624 for (unsigned i = 0; i < max_streams; i++) 1625 { 1626 str = &(basic_io_vector[i]); 1627 if (str->token != ClosedToken && str->device.ioDesc == ioDesc) 1628 return taskData->saveVec.push(str->token); 1629 } 1630 /* Have to make a new entry. */ 1631 Handle str_token = make_stream_entry(taskData); 1632 if (str_token == NULL) raise_syscall(taskData, "Insufficient memory", NOMEMORY); 1633 POLYUNSIGNED stream_no = STREAMID(str_token); 1634 str = &basic_io_vector[stream_no]; 1635 str->device.ioDesc = get_C_int(taskData, DEREFWORD(args)); 1636 /* We don't know whether it's open for read, write or even if 1637 it's open at all. */ 1638 str->ioBits = IO_BIT_OPEN | IO_BIT_READ | IO_BIT_WRITE ; 1639#if (defined(_WIN32) && ! defined(__CYGWIN__)) 1640 str->ioBits |= getFileType(ioDesc); 1641#endif 1642 return str_token; 1643 } 1644 1645 1646 /* Directory functions. */ 1647 case 50: /* Open a directory. */ 1648 return openDirectory(taskData, args); 1649 1650 case 51: /* Read a directory entry. */ 1651 return readDirectory(taskData, strm); 1652 1653 case 52: /* Close the directory */ 1654 return close_file(taskData, strm); 1655 1656 case 53: /* Rewind the directory. */ 1657 return rewindDirectory(taskData, strm, args); 1658 1659 case 54: /* Get current working directory. */ 1660 { 1661#if (defined(_WIN32) && ! defined(__CYGWIN__)) 1662 DWORD space = GetCurrentDirectory(0, NULL); 1663 if (space == 0) 1664 raise_syscall(taskData, "GetCurrentDirectory failed", GetLastError()); 1665 TempString buff((TCHAR*)malloc(space * sizeof(TCHAR))); 1666 if (buff == 0) raise_syscall(taskData, "Insufficient memory", NOMEMORY); 1667 if (GetCurrentDirectory(space, buff) == 0) 1668 raise_syscall(taskData, "GetCurrentDirectory failed", GetLastError()); 1669 return SAVE(C_string_to_Poly(taskData, buff)); 1670#else 1671 size_t size = 4096; 1672 TempString string_buffer((TCHAR *)malloc(size * sizeof(TCHAR))); 1673 if (string_buffer == NULL) raise_syscall(taskData, "Insufficient memory", NOMEMORY); 1674 TCHAR *cwd; 1675 while ((cwd = getcwd(string_buffer, size)) == NULL && errno == ERANGE) { 1676 if (size > std::numeric_limits<size_t>::max() / 2) raise_fail(taskData, "getcwd needs too large a buffer"); 1677 size *= 2; 1678 TCHAR *new_buf = (TCHAR *)realloc(string_buffer, size * sizeof(TCHAR)); 1679 if (new_buf == NULL) raise_syscall(taskData, "Insufficient memory", NOMEMORY); 1680 string_buffer = new_buf; 1681 } 1682 1683 if (cwd == NULL) 1684 raise_syscall(taskData, "getcwd failed", ERRORNUMBER); 1685 return SAVE(C_string_to_Poly(taskData, cwd)); 1686#endif 1687 } 1688 1689 case 55: /* Create a new directory. */ 1690 { 1691 TempString dirName(args->Word()); 1692 if (dirName == 0) raise_syscall(taskData, "Insufficient memory", NOMEMORY); 1693#if (defined(_WIN32) && ! defined(__CYGWIN__)) 1694 if (! CreateDirectory(dirName, NULL)) 1695 raise_syscall(taskData, "CreateDirectory failed", GetLastError()); 1696#else 1697 if (mkdir(dirName, 0777) != 0) 1698 raise_syscall(taskData, "mkdir failed", ERRORNUMBER); 1699#endif 1700 1701 return Make_fixed_precision(taskData, 0); 1702 } 1703 1704 case 56: /* Delete a directory. */ 1705 { 1706 TempString dirName(args->Word()); 1707 if (dirName == 0) raise_syscall(taskData, "Insufficient memory", NOMEMORY); 1708#if (defined(_WIN32) && ! defined(__CYGWIN__)) 1709 if (! RemoveDirectory(dirName)) 1710 raise_syscall(taskData, "RemoveDirectory failed", GetLastError()); 1711#else 1712 if (rmdir(dirName) != 0) 1713 raise_syscall(taskData, "rmdir failed", ERRORNUMBER); 1714#endif 1715 1716 return Make_fixed_precision(taskData, 0); 1717 } 1718 1719 case 57: /* Test for directory. */ 1720 return isDir(taskData, args); 1721 1722 case 58: /* Test for symbolic link. */ 1723 { 1724 TempString fileName(args->Word()); 1725 if (fileName == 0) raise_syscall(taskData, "Insufficient memory", NOMEMORY); 1726#if (defined(_WIN32) && ! defined(__CYGWIN__)) 1727 { 1728 DWORD dwRes = GetFileAttributes(fileName); 1729 if (dwRes == 0xFFFFFFFF) 1730 raise_syscall(taskData, "GetFileAttributes failed", GetLastError()); 1731 return Make_fixed_precision(taskData, (dwRes & FILE_ATTRIBUTE_REPARSE_POINT) ? 1:0); 1732 } 1733#else 1734 { 1735 struct stat fbuff; 1736 if (lstat(fileName, &fbuff) != 0) 1737 raise_syscall(taskData, "stat failed", ERRORNUMBER); 1738 return Make_fixed_precision(taskData, 1739 ((fbuff.st_mode & S_IFMT) == S_IFLNK) ? 1 : 0); 1740 } 1741#endif 1742 } 1743 1744 case 59: /* Read a symbolic link. */ 1745 { 1746#if (defined(_WIN32) && ! defined(__CYGWIN__)) 1747 // Windows has added symbolic links but reading the target is far from 1748 // straightforward. It's probably not worth trying to implement this. 1749 raise_syscall(taskData, "Symbolic links are not implemented", 0); 1750 return taskData->saveVec.push(TAGGED(0)); /* To keep compiler happy. */ 1751#else 1752 int nLen; 1753 TempString linkName(args->Word()); 1754 if (linkName == 0) raise_syscall(taskData, "Insufficient memory", NOMEMORY); 1755 1756 size_t size = 4096; 1757 TempString resBuf((TCHAR *)malloc(size * sizeof(TCHAR))); 1758 if (resBuf == NULL) raise_syscall(taskData, "Insufficient memory", NOMEMORY); 1759 // nLen is signed, so cast size to ssize_t to perform signed 1760 // comparison, avoiding an infinite loop when nLen is -1. 1761 while ((nLen = readlink(linkName, resBuf, size)) >= (ssize_t) size) { 1762 size *= 2; 1763 if (size > std::numeric_limits<ssize_t>::max()) raise_fail(taskData, "readlink needs too large a buffer"); 1764 TCHAR *newBuf = (TCHAR *)realloc(resBuf, size * sizeof(TCHAR)); 1765 if (newBuf == NULL) raise_syscall(taskData, "Insufficient memory", NOMEMORY); 1766 resBuf = newBuf; 1767 } 1768 if (nLen < 0) raise_syscall(taskData, "readlink failed", ERRORNUMBER); 1769 return(SAVE(C_string_to_Poly(taskData, resBuf, nLen))); 1770#endif 1771 } 1772 1773 case 60: /* Return the full absolute path name. */ 1774 return fullPath(taskData, args); 1775 1776 case 61: /* Modification time. */ 1777 return modTime(taskData, args); 1778 1779 case 62: /* File size. */ 1780 return fileSize(taskData, args); 1781 1782 case 63: /* Set file time. */ 1783 return setTime(taskData, strm, args); 1784 1785 case 64: /* Delete a file. */ 1786 { 1787 TempString fileName(args->Word()); 1788 if (fileName == 0) raise_syscall(taskData, "Insufficient memory", NOMEMORY); 1789#if (defined(_WIN32) && ! defined(__CYGWIN__)) 1790 if (! DeleteFile(fileName)) 1791 raise_syscall(taskData, "DeleteFile failed", GetLastError()); 1792#else 1793 if (unlink(fileName) != 0) 1794 raise_syscall(taskData, "unlink failed", ERRORNUMBER); 1795#endif 1796 1797 return Make_fixed_precision(taskData, 0); 1798 } 1799 1800 case 65: /* rename a file. */ 1801 return renameFile(taskData, strm, args); 1802 1803 case 66: /* Get access rights. */ 1804 return fileAccess(taskData, strm, args); 1805 1806 case 67: /* Return a temporary file name. */ 1807 { 1808#if (defined(_WIN32) && ! defined(__CYGWIN__)) 1809 DWORD dwSpace = GetTempPath(0, NULL); 1810 if (dwSpace == 0) 1811 raise_syscall(taskData, "GetTempPath failed", GetLastError()); 1812 TempString buff((TCHAR*)malloc((dwSpace + 12)*sizeof(TCHAR))); 1813 if (buff == 0) raise_syscall(taskData, "Insufficient memory", NOMEMORY); 1814 if (GetTempPath(dwSpace, buff) == 0) 1815 raise_syscall(taskData, "GetTempPath failed", GetLastError()); 1816 lstrcat(buff, _T("MLTEMPXXXXXX")); 1817#else 1818 const char *template_subdir = "/MLTEMPXXXXXX"; 1819#ifdef P_tmpdir 1820 TempString buff((TCHAR *)malloc(strlen(P_tmpdir) + strlen(template_subdir) + 1)); 1821 if (buff == 0) raise_syscall(taskData, "Insufficient memory", NOMEMORY); 1822 strcpy(buff, P_tmpdir); 1823#else 1824 const char *tmpdir = "/tmp"; 1825 TempString buff((TCHAR *)malloc(strlen(tmpdir) + strlen(template_subdir) + 1)); 1826 if (buff == 0) raise_syscall(taskData, "Insufficient memory", NOMEMORY); 1827 strcpy(buff, tmpdir); 1828#endif 1829 strcat(buff, template_subdir); 1830#endif 1831 1832#if (defined(HAVE_MKSTEMP) && ! defined(UNICODE)) 1833 // mkstemp is present in the Mingw64 headers but only as ANSI not Unicode. 1834 // Set the umask to mask out access by anyone else. 1835 // mkstemp generally does this anyway. 1836 mode_t oldMask = umask(0077); 1837 int fd = mkstemp(buff); 1838 int wasError = ERRORNUMBER; 1839 (void)umask(oldMask); 1840 if (fd != -1) close(fd); 1841 else raise_syscall(taskData, "mkstemp failed", wasError); 1842#else 1843 if (_tmktemp(buff) == 0) 1844 raise_syscall(taskData, "mktemp failed", ERRORNUMBER); 1845 int fd = _topen(buff, O_RDWR | O_CREAT | O_EXCL, 00600); 1846 if (fd != -1) close(fd); 1847 else raise_syscall(taskData, "Temporary file creation failed", ERRORNUMBER); 1848#endif 1849 Handle res = SAVE(C_string_to_Poly(taskData, buff)); 1850 return res; 1851 } 1852 1853 case 68: /* Get the file id. */ 1854 { 1855#if (defined(_WIN32) && ! defined(__CYGWIN__)) 1856 /* This concept does not exist in Windows. */ 1857 /* Return a negative number. This is interpreted 1858 as "not implemented". */ 1859 return Make_fixed_precision(taskData, -1); 1860#else 1861 struct stat fbuff; 1862 TempString fileName(args->Word()); 1863 if (fileName == 0) raise_syscall(taskData, "Insufficient memory", NOMEMORY); 1864 if (stat(fileName, &fbuff) != 0) 1865 raise_syscall(taskData, "stat failed", ERRORNUMBER); 1866 /* Assume that inodes are always non-negative. */ 1867 return Make_arbitrary_precision(taskData, fbuff.st_ino); 1868#endif 1869 } 1870 1871 case 69: /* Return an index for a token. */ 1872 return Make_fixed_precision(taskData, STREAMID(strm)); 1873 1874 case 70: /* Posix.FileSys.openf - open a file with given mode. */ 1875 { 1876 Handle name = taskData->saveVec.push(DEREFWORDHANDLE(args)->Get(0)); 1877 int mode = get_C_int(taskData, DEREFWORDHANDLE(args)->Get(1)); 1878 return open_file(taskData, name, mode, 0666, 1); 1879 } 1880 1881 case 71: /* Posix.FileSys.createf - create a file with given mode and access. */ 1882 { 1883 Handle name = taskData->saveVec.push(DEREFWORDHANDLE(args)->Get(0)); 1884 int mode = get_C_int(taskData, DEREFWORDHANDLE(args)->Get(1)); 1885 int access = get_C_int(taskData, DEREFWORDHANDLE(args)->Get(2)); 1886 return open_file(taskData, name, mode|O_CREAT, access, 1); 1887 } 1888 1889 default: 1890 { 1891 char msg[100]; 1892 sprintf(msg, "Unknown io function: %d", c); 1893 raise_exception_string(taskData, EXC_Fail, msg); 1894 return 0; 1895 } 1896 } 1897} 1898 1899// General interface to IO. Ideally the various cases will be made into 1900// separate functions. 1901POLYUNSIGNED PolyBasicIOGeneral(PolyObject *threadId, PolyWord code, PolyWord strm, PolyWord arg) 1902{ 1903 TaskData *taskData = TaskData::FindTaskForId(threadId); 1904 ASSERT(taskData != 0); 1905 taskData->PreRTSCall(); 1906 Handle reset = taskData->saveVec.mark(); 1907 Handle pushedCode = taskData->saveVec.push(code); 1908 Handle pushedStrm = taskData->saveVec.push(strm); 1909 Handle pushedArg = taskData->saveVec.push(arg); 1910 Handle result = 0; 1911 1912 try { 1913 result = IO_dispatch_c(taskData, pushedArg, pushedStrm, pushedCode); 1914 } 1915 catch (KillException &) { 1916 processes->ThreadExit(taskData); // TestAnyEvents may test for kill 1917 } 1918 catch (...) { } // If an ML exception is raised 1919 1920 taskData->saveVec.reset(reset); 1921 taskData->PostRTSCall(); 1922 if (result == 0) return TAGGED(0).AsUnsigned(); 1923 else return result->Word().AsUnsigned(); 1924} 1925 1926struct _entrypts basicIOEPT[] = 1927{ 1928 { "PolyChDir", (polyRTSFunction)&PolyChDir}, 1929 { "PolyBasicIOGeneral", (polyRTSFunction)&PolyBasicIOGeneral}, 1930 1931 { NULL, NULL} // End of list. 1932}; 1933 1934class BasicIO: public RtsModule 1935{ 1936public: 1937 virtual void Init(void); 1938 virtual void Start(void); 1939 virtual void Stop(void); 1940 void GarbageCollect(ScanAddress *process); 1941}; 1942 1943// Declare this. It will be automatically added to the table. 1944static BasicIO basicIOModule; 1945 1946void BasicIO::Init(void) 1947{ 1948 max_streams = 20; // Initialise to the old Unix maximum. Will grow if necessary. 1949 /* A vector for the streams (initialised by calloc) */ 1950 basic_io_vector = (PIOSTRUCT)calloc(max_streams, sizeof(IOSTRUCT)); 1951 for (unsigned i = 0; i < max_streams; i++) 1952 basic_io_vector[i].token = ClosedToken; 1953} 1954 1955void BasicIO::Start(void) 1956{ 1957 basic_io_vector[0].token = TAGGED(0); 1958 basic_io_vector[0].device.ioDesc = 0; 1959 basic_io_vector[0].ioBits = IO_BIT_OPEN | IO_BIT_READ; 1960#if (defined(_WIN32) && ! defined(__CYGWIN__)) 1961 basic_io_vector[0].ioBits |= getFileType(0); 1962 // Set this to a duplicate of the handle so it can be closed when we 1963 // close the stream. 1964 HANDLE hDup; 1965 if (DuplicateHandle(GetCurrentProcess(), hInputEvent, GetCurrentProcess(), 1966 &hDup, 0, FALSE, DUPLICATE_SAME_ACCESS)) 1967 basic_io_vector[0].hAvailable = hDup; 1968#endif 1969 1970 basic_io_vector[1].token = TAGGED(1); 1971 basic_io_vector[1].device.ioDesc = 1; 1972 basic_io_vector[1].ioBits = IO_BIT_OPEN | IO_BIT_WRITE; 1973#if (defined(_WIN32) && ! defined(__CYGWIN__)) 1974 basic_io_vector[1].ioBits |= getFileType(1); 1975#endif 1976 1977 basic_io_vector[2].token = TAGGED(2); 1978 basic_io_vector[2].device.ioDesc = 2; 1979 basic_io_vector[2].ioBits = IO_BIT_OPEN | IO_BIT_WRITE; 1980#if (defined(_WIN32) && ! defined(__CYGWIN__)) 1981 basic_io_vector[2].ioBits |= getFileType(2); 1982#endif 1983 return; 1984} 1985 1986/* Release all resources. Not strictly necessary since the OS should 1987 do this but probably a good idea. */ 1988void BasicIO::Stop(void) 1989{ 1990 if (basic_io_vector) 1991 { 1992 // Don't close the standard streams since we may need 1993 // stdout at least to produce final debugging output. 1994 for (unsigned i = 3; i < max_streams; i++) 1995 { 1996 if (isOpen(&basic_io_vector[i])) 1997 close_stream(&basic_io_vector[i]); 1998 } 1999 free(basic_io_vector); 2000 } 2001 basic_io_vector = NULL; 2002} 2003 2004void BasicIO::GarbageCollect(ScanAddress *process) 2005/* Ensures that all the objects are retained and their addresses updated. */ 2006{ 2007 /* Entries in the file table. These are marked as weak references so may 2008 return 0 for unreferenced streams. */ 2009 for(unsigned i = 0; i < max_streams; i++) 2010 { 2011 PIOSTRUCT str = &(basic_io_vector[i]); 2012 2013 if (str->token.IsDataPtr()) 2014 { 2015 PolyObject *token = str->token.AsObjPtr(); 2016 process->ScanRuntimeAddress(&token, ScanAddress::STRENGTH_WEAK); 2017 2018 /* Unreferenced streams may return zero. */ 2019 if (token == 0 && isOpen(str)) 2020 close_stream(str); 2021 str->token = token == 0 ? ClosedToken : token; 2022 } 2023 } 2024} 2025