File: winbasicio.cpp

package info (click to toggle)
polyml 5.8.1-1~exp1
  • links: PTS, VCS
  • area: main
  • in suites: experimental
  • size: 57,736 kB
  • sloc: cpp: 44,918; ansic: 26,921; asm: 13,495; sh: 4,670; makefile: 610; exp: 525; python: 253; awk: 91
file content (1399 lines) | stat: -rw-r--r-- 50,450 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
/*
    Title:      Basic IO for Windows.

    Copyright (c) 2000, 2015-2019 David C. J. Matthews

    This was split from the common code for Unix and Windows.

    Portions of this code are derived from the original stream io
    package copyright CUTS 1983-2000.

    This library is free software; you can redistribute it and/or
    modify it under the terms of the GNU Lesser General Public
    License version 2.1 as published by the Free Software Foundation.
    
    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
    Lesser General Public License for more details.
    
    You should have received a copy of the GNU Lesser General Public
    License along with this library; if not, write to the Free Software
    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA

*/

#ifdef HAVE_CONFIG_H
#include "config.h"
#elif defined(_WIN32)
#include "winconfig.h"
#else
#error "No configuration file"
#endif

#ifdef HAVE_FCNTL_H
#include <fcntl.h>
#endif
#ifdef HAVE_SYS_TYPES_H
#include <sys/types.h>
#endif
#ifdef HAVE_SYS_STAT_H
#include <sys/stat.h>
#endif
#ifdef HAVE_ASSERT_H
#include <assert.h>
#define ASSERT(x) assert(x)
#else
#define ASSERT(x) 0
#endif
#ifdef HAVE_ERRNO_H
#include <errno.h>
#endif
#ifdef HAVE_SIGNAL_H
#include <signal.h>
#endif
#ifdef HAVE_STDLIB_H
#include <stdlib.h>
#endif
#ifdef HAVE_ALLOCA_H
#include <alloca.h>
#endif
#ifdef HAVE_IO_H
#include <io.h>
#endif
#ifdef HAVE_SYS_PARAM_H
#include <sys/param.h>
#endif
#ifdef HAVE_SYS_IOCTL_H
#include <sys/ioctl.h>
#endif
#ifdef HAVE_SYS_TIME_H
#include <sys/time.h>
#endif
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
#ifdef HAVE_POLL_H
#include <poll.h>
#endif
#ifdef HAVE_STRING_H
#include <string.h>
#endif
#ifdef HAVE_SYS_SELECT_H
#include <sys/select.h>
#endif
#ifdef HAVE_MALLOC_H
#include <malloc.h>
#endif
#ifdef HAVE_DIRECT_H
#include <direct.h>
#endif
#ifdef HAVE_STDIO_H
#include <stdio.h>
#endif

#include <limits>

#include <winsock2.h>
#include <tchar.h>

#ifndef INFTIM
#define INFTIM (-1)
#endif

#include <new>

#include "globals.h"
#include "basicio.h"
#include "sys.h"
#include "gc.h"
#include "run_time.h"
#include "machine_dep.h"
#include "arb.h"
#include "processes.h"
#include "diagnostics.h"
#include "io_internal.h"
#include "scanaddrs.h"
#include "polystring.h"
#include "mpoly.h"
#include "save_vec.h"
#include "rts_module.h"
#include "locking.h"
#include "rtsentry.h"
#include "timing.h"
#include "winstartup.h"

#define NOMEMORY ERROR_NOT_ENOUGH_MEMORY
#define STREAMCLOSED ERROR_INVALID_HANDLE
#define FILEDOESNOTEXIST ERROR_FILE_NOT_FOUND
#define ERRORNUMBER _doserrno

#ifndef O_ACCMODE
#define O_ACCMODE   (O_RDONLY|O_RDWR|O_WRONLY)
#endif

#define SAVE(x) taskData->saveVec.push(x)

#ifdef _MSC_VER
// Don't tell me about ISO C++ changes.
#pragma warning(disable:4996)
#endif

extern "C" {
    POLYEXTERNALSYMBOL POLYUNSIGNED PolyChDir(PolyObject *threadId, PolyWord arg);
    POLYEXTERNALSYMBOL POLYUNSIGNED PolyBasicIOGeneral(PolyObject *threadId, PolyWord code, PolyWord strm, PolyWord arg);
}

// References to the standard streams.  They are only needed if we are compiling
// the basis library and make a second call to get the standard streams.
static PolyObject *standardInputValue, *standardOutputValue, *standardErrorValue;

// Creates a new unique pipename in the appropriate format.
// Utility function provided for winguiconsole and windows_specific
void newPipeName(TCHAR *pipeName)
{
    static LONG pipenum = 0;
    wsprintf(pipeName, _T("\\\\.\\Pipe\\PolyPipe.%08x.%08x"), GetCurrentProcessId(), InterlockedIncrement(&pipenum));
}

int WinStream::fileTypeOfHandle(HANDLE hStream)
{
    switch (GetFileType(hStream))
    {
    case FILE_TYPE_PIPE: return FILEKIND_PIPE;
    case FILE_TYPE_CHAR: return FILEKIND_TTY;// Or a device?
    case FILE_TYPE_DISK: return FILEKIND_FILE;
    default:
        if (GetLastError() == 0)
            return FILEKIND_UNKNOWN; // Error or unknown.
        else return FILEKIND_ERROR;
    }
}

void WinStream::waitUntilAvailable(TaskData *taskData)
{
    while (!isAvailable(taskData))
    {
        WaitHandle waiter(NULL);
        processes->ThreadPauseForIO(taskData, &waiter);
    }
}

void WinStream::waitUntilOutputPossible(TaskData *taskData)
{
    while (!canOutput(taskData))
    {
        // Use the default waiter for the moment since we don't have
        // one to test for output.
        processes->ThreadPauseForIO(taskData, Waiter::defaultWaiter);
    }
}

void WinStream::unimplemented(TaskData *taskData)
{
    // Called on the random access functions
    raise_syscall(taskData, "Position error", ERROR_NOT_SUPPORTED);
}

WinInOutStream::WinInOutStream()
{
    hStream = hEvent = INVALID_HANDLE_VALUE;
    buffer = 0;
    currentInBuffer = currentPtr = 0;
    endOfStream = false;
    buffSize = 4096; // Seems like a good number
    ZeroMemory(&overlap, sizeof(overlap));
    isText = false;
    isRead = true;
}

WinInOutStream::~WinInOutStream()
{
    free(buffer);
}

void WinInOutStream::openFile(TaskData * taskData, TCHAR *name, openMode mode, bool isT)
{
    isRead = mode == OPENREAD;
    isText = isT;
    ASSERT(hStream == INVALID_HANDLE_VALUE); // We should never reuse an object.
    buffer = (byte*)malloc(buffSize);
    if (buffer == 0)
        raise_syscall(taskData, "Insufficient memory", NOMEMORY);
    // Create a manual reset event with state=signalled.  This means
    // that no operation is in progress.
    hEvent = CreateEvent(NULL, TRUE, TRUE, NULL);
    overlap.hEvent = hEvent;
    switch (mode)
    {
    case OPENREAD:
        hStream = CreateFile(name, GENERIC_READ, FILE_SHARE_READ, NULL, OPEN_EXISTING, FILE_FLAG_OVERLAPPED, NULL);
        break;
    case OPENWRITE:
        hStream = CreateFile(name, GENERIC_WRITE, FILE_SHARE_READ, NULL, CREATE_ALWAYS, FILE_FLAG_OVERLAPPED, NULL);
        break;
    case OPENAPPEND:
        hStream = CreateFile(name, GENERIC_WRITE, FILE_SHARE_READ, NULL, OPEN_ALWAYS, FILE_FLAG_OVERLAPPED, NULL);
        break;
    }
    if (hStream == INVALID_HANDLE_VALUE)
        raise_syscall(taskData, "CreateFile failed", GetLastError());
    // Start a read immediately so that there is something in the buffer.
    switch (mode)
    {
    case OPENREAD:
        if(!beginReading())
            raise_syscall(taskData, "Read failure", GetLastError()); break;
    case OPENWRITE: break;
    case OPENAPPEND:
    {
        // We could use the special 0xfff... value in the overlapped structure for this
        // but that would mess up getPos/endPos.
        LARGE_INTEGER fileSize;
        if (!GetFileSizeEx(hStream, &fileSize))
            raise_syscall(taskData, "Stream is not a file", GetLastError());
        setOverlappedPos(fileSize.QuadPart);
    }
    break;
    }
}

// This is only used to set up standard output.
// Now also used for Windows.execute.
bool WinInOutStream::openHandle(HANDLE hndl, openMode mode, bool isT)
{
    // Need to check the handle.  It seems DuplicateHandle actually allows an invalid handle
    if (hndl == INVALID_HANDLE_VALUE)
    {
        SetLastError(ERROR_INVALID_HANDLE);
        return false;
    }
    isRead = mode == OPENREAD;
    isText = isT;
    ASSERT(hStream == INVALID_HANDLE_VALUE); // We should never reuse an object.
    buffer = (byte*)malloc(buffSize);
    if (buffer == 0)
    {
        SetLastError(NOMEMORY);
        return false;
    }
    hEvent = CreateEvent(NULL, TRUE, TRUE, NULL);
    overlap.hEvent = hEvent;
    // Duplicate the handle so we can safely close it.
    if (!DuplicateHandle(GetCurrentProcess(), hndl, GetCurrentProcess(), &hStream, 0, FALSE, DUPLICATE_SAME_ACCESS))
        return false;
    if (isRead)
        return beginReading();
    return true;
}

// Start reading.  This may complete immediately.
bool WinInOutStream::beginReading()
{
    if (!ReadFile(hStream, buffer, buffSize, NULL, &overlap))
    {
        switch (GetLastError())
        {
        case ERROR_HANDLE_EOF:
            // We get ERROR_BROKEN_PIPE as EOF on a pipe.
        case ERROR_BROKEN_PIPE:
            endOfStream = true;
        case ERROR_IO_PENDING:
            return true;
        default:
            return false;
        }
    }
    return true;
}

void WinInOutStream::closeEntry(TaskData *taskData)
{
    if (isRead)
    {
        if (WaitForSingleObject(hEvent, 0) == WAIT_TIMEOUT)
            // Something is in progress.
            CancelIoEx(hStream, &overlap);
    }
    else flushOut(taskData);

    PLocker locker(&lock);
    if (!CloseHandle(hStream))
        raise_syscall(taskData, "CloseHandle failed", GetLastError());
    hStream = INVALID_HANDLE_VALUE;
    CloseHandle(hEvent);
    hEvent = INVALID_HANDLE_VALUE;
}

// Make sure that everything has been written.
void WinInOutStream::flushOut(TaskData *taskData)
{
    while (currentInBuffer != 0)
    {
        // If currentInBuffer is not zero we have an operation in progress.
        waitUntilOutputPossible(taskData); // canOutput will test the result and may update currentInBuffer.
        // We may not have written everything so check and repeat if necessary.
        if (currentInBuffer != 0)
            writeStream(taskData, NULL, 0);
    }
}

size_t WinInOutStream::readStream(TaskData *taskData, byte *base, size_t length)
{
    PLocker locker(&lock);
    if (endOfStream) return 0;
    size_t copied = 0;
    // Copy as much as we can from the buffer.
    while (currentPtr < currentInBuffer && copied < length)
    {
        byte b = buffer[currentPtr++];
        // In text mode we want to return NL for CRNL.  Assume that this is
        // properly formatted and simply skip CRs.  It's not clear what to return
        // if it isn't properly formatted and the user can always open it as binary
        // and do the conversion.
        if (!isText || b != '\r')
            base[copied++] = b;
    }
    // If we have exhausted the buffer we start a new read.
    while (isText && currentPtr < currentInBuffer && buffer[currentPtr] == '\r')
        currentPtr++;
    if (currentInBuffer == currentPtr)
    {
        // We need to start a new read
        currentInBuffer = currentPtr = 0;
        if (!beginReading())
            raise_syscall(taskData, "Read failure", GetLastError());
    }
    return copied;
}

// This actually does most of the work.  In particular for text streams we may have a
// block that consists only of CRs.
bool WinInOutStream::isAvailable(TaskData *taskData)
{
    while (1)
    {
        {
            PLocker locker(&lock);
            // It is available if we have something in the buffer or we're at EOF
            if (currentInBuffer < currentPtr || endOfStream)
                return true;
            // We should have had a read in progress.
            DWORD bytesRead = 0;
            if (!GetOverlappedResult(hStream, &overlap, &bytesRead, FALSE))
            {
                DWORD err = GetLastError();
                switch (err)
                {
                case ERROR_HANDLE_EOF:
                case ERROR_BROKEN_PIPE:
                    // We've had EOF - That result is available
                    endOfStream = true;
                    return true;
                case ERROR_IO_INCOMPLETE:
                    // It's still in progress.
                    return false;
                default:
                    raise_syscall(taskData, "GetOverlappedResult failed", err);
                }
            }
            // The next read must be after this.
            setOverlappedPos(getOverlappedPos() + bytesRead);
            currentInBuffer = bytesRead;
            // If this is a text stream skip CRs.
            while (isText && currentPtr < currentInBuffer && buffer[currentPtr] == '\r')
                currentPtr++;
            // If we have some real data it can be read now
            if (currentPtr < currentInBuffer)
                return true;
        }
        // Try again.
        if (!beginReading()) // And loop
            raise_syscall(taskData, "Read failure", GetLastError());
    }
}

void WinInOutStream::waitUntilAvailable(TaskData *taskData)
{
    while (!isAvailable(taskData))
    {
        WaitHandle waiter(hEvent);
        processes->ThreadPauseForIO(taskData, &waiter);
    }
}

int WinInOutStream::poll(TaskData *taskData, int test)
{
    if (test & POLL_BIT_IN)
    {
        if (isAvailable(taskData))
            return POLL_BIT_IN;
    }
    if (test & POLL_BIT_OUT)
    {
        if (canOutput(taskData))
            return POLL_BIT_OUT;
    }

    return 0;
}

// Random access functions
uint64_t WinInOutStream::getPos(TaskData *taskData)
{
    if (GetFileType(hStream) != FILE_TYPE_DISK)
        raise_syscall(taskData, "Stream is not a file", ERROR_SEEK_ON_DEVICE);
    PLocker locker(&lock);
    if (isRead)
        return getOverlappedPos() - currentInBuffer + currentPtr;
    else return getOverlappedPos() + currentInBuffer;
}

void WinInOutStream::setPos(TaskData *taskData, uint64_t pos)
{
    if (GetFileType(hStream) != FILE_TYPE_DISK)
        raise_syscall(taskData, "Stream is not a file", ERROR_SEEK_ON_DEVICE);
    // Need to wait until any pending operation is complete.  If this is a write
    // we need to flush anything before changing the position.
    if (isRead)
    {
        
        while (WaitForSingleObject(hEvent, 0) == WAIT_TIMEOUT)
        {
            WaitHandle waiter(hEvent);
            processes->ThreadPauseForIO(taskData, &waiter);
        }
    }
    else flushOut(taskData);

    PLocker locker(&lock);
    setOverlappedPos(pos);
    // Discard any unread data and start reading at the new position.
    currentInBuffer = currentPtr = 0;
    endOfStream = false;
    if (isRead && !beginReading())
        raise_syscall(taskData, "Read failure", GetLastError());
}

uint64_t WinInOutStream::fileSize(TaskData *taskData)
{
    LARGE_INTEGER fileSize;
    if (!GetFileSizeEx(hStream, &fileSize))
        raise_syscall(taskData, "Stream is not a file", GetLastError());
    return fileSize.QuadPart;
}


bool WinInOutStream::canOutput(TaskData *taskData)
{
    if (isRead)
        unimplemented(taskData);

    PLocker locker(&lock);
    // If the buffer is empty we're fine.
    if (currentInBuffer == 0)
        return true;
    // Otherwise there is an operation in progress.  Has it finished?
    DWORD bytesWritten = 0;
    if (!GetOverlappedResult(hStream, &overlap, &bytesWritten, FALSE))
    {
        DWORD err = GetLastError();
        if (err == ERROR_IO_INCOMPLETE)
            return false;
        else raise_syscall(taskData, "GetOverlappedResult failed", err);
    }
    setOverlappedPos(getOverlappedPos() + bytesWritten);
    // If we haven't written everything copy down what we have left.
    if (bytesWritten < currentInBuffer)
        memmove(buffer, buffer + bytesWritten, currentInBuffer - bytesWritten);
    currentInBuffer -= bytesWritten;
    // This will then be written before anything else.
    return true;
}

void WinInOutStream::waitUntilOutputPossible(TaskData *taskData)
{
    if (isRead)
        unimplemented(taskData);

    while (!canOutput(taskData))
    {
        WaitHandle waiter(hEvent);
        processes->ThreadPauseForIO(taskData, &waiter);
    }
}

// Write data.  N.B.  This is also used with zero data from closeEntry.
size_t WinInOutStream::writeStream(TaskData *taskData, byte *base, size_t length)
{
    if (isRead)
        unimplemented(taskData);

    PLocker locker(&lock);
    // Copy as much as we can into the buffer.
    size_t copied = 0;
    while (currentInBuffer < buffSize && copied < length)
    {
        if (isText && base[copied] == '\n')
        {
            // Put in a CR but make sure we've space for both.
            if (currentInBuffer == buffSize - 1)
                break; // Exit the loop with what we've done.
            buffer[currentInBuffer++] = '\r';
        }
        buffer[currentInBuffer++] = base[copied++];
    }

    // Write what's in the buffer.
    if (!WriteFile(hStream, buffer, currentInBuffer, NULL, &overlap))
    {
        DWORD dwErr = GetLastError();
        if (dwErr != ERROR_IO_PENDING)
            raise_syscall(taskData, "WriteFile failed", dwErr);
    }
    // Even if it actually succeeded we still pick up the result in canOutput.
    return copied; // Return what we copied.
}

/* Open a file in the required mode. */
static Handle openWinFile(TaskData *taskData, Handle filename, openMode mode, bool isAppend, bool isBinary)
{
    TempString cFileName(filename->Word()); // Get file name
    if (cFileName == 0) raise_syscall(taskData, "Insufficient memory", NOMEMORY);
    try {
        WinInOutStream *stream = new WinInOutStream();
        stream->openFile(taskData, cFileName, mode, !isBinary);
        return MakeVolatileWord(taskData, stream);
    }
    catch (std::bad_alloc&) {
        raise_syscall(taskData, "Insufficient memory", NOMEMORY);
    }
}

/* Read into an array. */
// We can't combine readArray and readString because we mustn't compute the
// destination of the data in readArray until after any GC.
static Handle readArray(TaskData *taskData, Handle stream, Handle args, bool/*isText*/)
{
    WinStream *strm = *(WinStream**)(stream->WordP());
    if (strm == 0) raise_syscall(taskData, "Stream is closed", STREAMCLOSED);
    /* The isText argument is ignored in both Unix and Windows but
    is provided for future use.  Windows remembers the mode used
    when the file was opened to determine whether to translate
    CRLF into LF. */
    // We should check for interrupts even if we're not going to block.
    processes->TestAnyEvents(taskData);

    // First test to see if we have input available.
    // These tests may result in a GC if another thread is running.
    strm->waitUntilAvailable(taskData);

    // We can now try to read without blocking.
    // Actually there's a race here in the unlikely situation that there
    // are multiple threads sharing the same low-level reader.  They could
    // both detect that input is available but only one may succeed in
    // reading without blocking.  This doesn't apply where the threads use
    // the higher-level IO interfaces in ML which have their own mutexes.
    byte *base = DEREFHANDLE(args)->Get(0).AsObjPtr()->AsBytePtr();
    POLYUNSIGNED offset = getPolyUnsigned(taskData, DEREFWORDHANDLE(args)->Get(1));
    size_t length = getPolyUnsigned(taskData, DEREFWORDHANDLE(args)->Get(2));
    size_t haveRead = strm->readStream(taskData, base + offset, length);
    return Make_fixed_precision(taskData, haveRead); // Success.
}

/* Return input as a string. We don't actually need both readArray and
readString but it's useful to have both to reduce unnecessary garbage.
The IO library will construct one from the other but the higher levels
choose the appropriate function depending on need. */
static Handle readString(TaskData *taskData, Handle stream, Handle args, bool/*isText*/)
{
    size_t length = getPolyUnsigned(taskData, DEREFWORD(args));
    WinStream *strm = *(WinStream**)(stream->WordP());
    if (strm == 0) raise_syscall(taskData, "Stream is closed", STREAMCLOSED);

    // We should check for interrupts even if we're not going to block.
    processes->TestAnyEvents(taskData);

    // First test to see if we have input available.
    // These tests may result in a GC if another thread is running.
    strm->waitUntilAvailable(taskData);

    // We can now try to read without blocking.
    // We previously allocated the buffer on the stack but that caused
    // problems with multi-threading at least on Mac OS X because of
    // stack exhaustion.  We limit the space to 100k. */
    if (length > 102400) length = 102400;
    byte *buff = (byte*)malloc(length);
    if (buff == 0) raise_syscall(taskData, "Unable to allocate buffer", NOMEMORY);

    try {
        size_t haveRead = strm->readStream(taskData, buff, length);
        Handle result = SAVE(C_string_to_Poly(taskData, (char*)buff, haveRead));
        free(buff);
        return result;
    }
    catch (...) {
        free(buff);
        throw;
    }
}

static Handle writeArray(TaskData *taskData, Handle stream, Handle args, bool/*isText*/)
{
    // The isText argument is ignored in both Unix and Windows but
    // is provided for future use.  Windows remembers the mode used
    // when the file was opened to determine whether to translate
    // LF into CRLF.
    WinStream *strm = *(WinStream**)(stream->WordP());
    if (strm == 0) raise_syscall(taskData, "Stream is closed", STREAMCLOSED);

    // We should check for interrupts even if we're not going to block.
    processes->TestAnyEvents(taskData);
    strm->waitUntilOutputPossible(taskData);

    PolyWord base = DEREFWORDHANDLE(args)->Get(0);
    POLYUNSIGNED    offset = getPolyUnsigned(taskData, DEREFWORDHANDLE(args)->Get(1));
    size_t length = getPolyUnsigned(taskData, DEREFWORDHANDLE(args)->Get(2));
    /* We don't actually handle cases of blocking on output. */
    byte *toWrite = base.AsObjPtr()->AsBytePtr();
    size_t haveWritten = strm->writeStream(taskData, toWrite + offset, length);
    return Make_fixed_precision(taskData, haveWritten);
}

Handle pollTest(TaskData *taskData, Handle stream)
{
    WinStream *strm = *(WinStream**)(stream->WordP());
    return Make_fixed_precision(taskData, strm->pollTest());
}

// Do the polling.  Takes a vector of io descriptors, a vector of bits to test
// and a time to wait and returns a vector of results.

// Windows: This is messy because "select" only works on sockets.
// Do the best we can.
static Handle pollDescriptors(TaskData *taskData, Handle args, int blockType)
{
    Handle hSave = taskData->saveVec.mark();
TryAgain:
    PolyObject  *strmVec = DEREFHANDLE(args)->Get(0).AsObjPtr();
    PolyObject  *bitVec = DEREFHANDLE(args)->Get(1).AsObjPtr();
    POLYUNSIGNED nDesc = strmVec->Length();
    ASSERT(nDesc == bitVec->Length());
    // We should check for interrupts even if we're not going to block.
    processes->TestAnyEvents(taskData);

    /* Simply do a non-blocking poll. */
    /* Record the results in this vector. */
    char *results = 0;
    bool haveResult = false;
    Handle  resVec;
    if (nDesc > 0)
    {
        results = (char*)alloca(nDesc);
        memset(results, 0, nDesc);
    }

    for (POLYUNSIGNED i = 0; i < nDesc; i++)
    {
        WinStream *strm = *(WinStream**)(strmVec->Get(i).AsObjPtr());
        if (strm == NULL) raise_syscall(taskData, "Stream is closed", STREAMCLOSED);
        int bits = get_C_int(taskData, bitVec->Get(i));
        results[i] = strm->poll(taskData, bits);
        if (results[i] != 0)
            haveResult = true;
    }
    if (haveResult == 0)
    {
        /* Poll failed - treat as time out. */
        switch (blockType)
        {
        case 0: /* Check the time out. */
        {
            Handle hSave = taskData->saveVec.mark();
            /* The time argument is an absolute time. */
            FILETIME ftTime, ftNow;
            /* Get the file time. */
            getFileTimeFromArb(taskData, taskData->saveVec.push(DEREFHANDLE(args)->Get(2)), &ftTime);
            GetSystemTimeAsFileTime(&ftNow);
            taskData->saveVec.reset(hSave);
            /* If the timeout time is earlier than the current time
            we must return, otherwise we block. */
            if (CompareFileTime(&ftTime, &ftNow) <= 0)
                break; /* Return the empty set. */
                        /* else drop through and block. */
        }
        case 1: /* Block until one of the descriptors is ready. */
            processes->ThreadPause(taskData);
            taskData->saveVec.reset(hSave);
            goto TryAgain;
            /*NOTREACHED*/
        case 2: /* Just a simple poll - drop through. */
            break;
        }
    }
    /* Copy the results to a result vector. */
    resVec = alloc_and_save(taskData, nDesc);
    for (POLYUNSIGNED j = 0; j < nDesc; j++)
        (DEREFWORDHANDLE(resVec))->Set(j, TAGGED(results[j]));
    return resVec;
}

// Directory functions.
class WinDirData
{
public:
    HANDLE  hFind; /* FindFirstFile handle */
    WIN32_FIND_DATA lastFind;
    int fFindSucceeded;
};

static Handle openDirectory(TaskData *taskData, Handle dirname)
{
    // Get the directory name but add on two characters for the \* plus one for the NULL.
    POLYUNSIGNED length = PolyStringLength(dirname->Word());
    TempString dirName((TCHAR*)malloc((length + 3) * sizeof(TCHAR)));
    if (dirName == 0) raise_syscall(taskData, "Insufficient memory", NOMEMORY);
    Poly_string_to_C(dirname->Word(), dirName, length + 2);
    // Tack on \* to the end so that we find all files in the directory.
    lstrcat(dirName, _T("\\*"));
    WinDirData *pData = new WinDirData; // TODO: Handle failue
    HANDLE hFind = FindFirstFile(dirName, &pData->lastFind);
    if (hFind == INVALID_HANDLE_VALUE)
        raise_syscall(taskData, "FindFirstFile failed", GetLastError());
    pData->hFind = hFind;
    /* There must be at least one file which matched. */
    pData->fFindSucceeded = 1;
    return MakeVolatileWord(taskData, pData);
}


/* Return the next entry from the directory, ignoring current and
parent arcs ("." and ".." in Windows and Unix) */
Handle readDirectory(TaskData *taskData, Handle stream)
{
    WinDirData *pData = *(WinDirData**)(stream->WordP()); // In a Volatile
    if (pData == 0) raise_syscall(taskData, "Stream is closed", STREAMCLOSED);
    Handle result = NULL;
    // The next entry to read is already in the buffer. FindFirstFile
    // both opens the directory and returns the first entry. If
    // fFindSucceeded is false we have already reached the end.
    if (!pData->fFindSucceeded)
        return SAVE(EmptyString(taskData));
    while (result == NULL)
    {
        WIN32_FIND_DATA *pFind = &(pData->lastFind);
        if (!((pFind->dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) &&
            (lstrcmp(pFind->cFileName, _T(".")) == 0 ||
                lstrcmp(pFind->cFileName, _T("..")) == 0)))
        {
            result = SAVE(C_string_to_Poly(taskData, pFind->cFileName));
        }
        /* Get the next entry. */
        if (!FindNextFile(pData->hFind, pFind))
        {
            DWORD dwErr = GetLastError();
            if (dwErr == ERROR_NO_MORE_FILES)
            {
                pData->fFindSucceeded = 0;
                if (result == NULL) return SAVE(EmptyString(taskData));
            }
        }
    }
    return result;
}

Handle rewindDirectory(TaskData *taskData, Handle stream, Handle dirname)
{
    WinDirData *pData = *(WinDirData**)(stream->WordP()); // In a SysWord
    if (pData == 0) raise_syscall(taskData, "Stream is closed", STREAMCLOSED);
    // There's no rewind - close and reopen.
    FindClose(pData->hFind);
    POLYUNSIGNED length = PolyStringLength(dirname->Word());
    TempString dirName((TCHAR*)malloc((length + 3) * sizeof(TCHAR)));
    if (dirName == 0) raise_syscall(taskData, "Insufficient memory", NOMEMORY);
    Poly_string_to_C(dirname->Word(), dirName, length + 2);
    // Tack on \* to the end so that we find all files in the directory.
    lstrcat(dirName, _T("\\*"));
    HANDLE hFind = FindFirstFile(dirName, &(pData->lastFind));
    if (hFind == INVALID_HANDLE_VALUE)
        raise_syscall(taskData, "FindFirstFile failed", GetLastError());
    pData->hFind = hFind;
    /* There must be at least one file which matched. */
    pData->fFindSucceeded = 1;
    return Make_fixed_precision(taskData, 0);
}

static Handle closeDirectory(TaskData *taskData, Handle stream)
{
    WinDirData *pData = *(WinDirData**)(stream->WordP()); // In a SysWord
    if (pData != 0)
    {
        FindClose(pData->hFind);
        delete(pData);
        *((WinDirData**)stream->WordP()) = 0; // Clear this - no longer valid
    }
    return Make_fixed_precision(taskData, 0);
}

/* change_dirc - this is called directly and not via the dispatch
   function. */
static Handle change_dirc(TaskData *taskData, Handle name)
/* Change working directory. */
{
    TempString cDirName(name->Word());
    if (cDirName == 0) raise_syscall(taskData, "Insufficient memory", NOMEMORY);
    if (SetCurrentDirectory(cDirName) == FALSE)
       raise_syscall(taskData, "SetCurrentDirectory failed", GetLastError());
    return SAVE(TAGGED(0));
}

// External call
POLYUNSIGNED PolyChDir(PolyObject *threadId, PolyWord arg)
{
    TaskData *taskData = TaskData::FindTaskForId(threadId);
    ASSERT(taskData != 0);
    taskData->PreRTSCall();
    Handle reset = taskData->saveVec.mark();
    Handle pushedArg = taskData->saveVec.push(arg);

    try {
        (void)change_dirc(taskData, pushedArg);
    } catch (...) { } // If an ML exception is raised

    taskData->saveVec.reset(reset); // Ensure the save vec is reset
    taskData->PostRTSCall();
    return TAGGED(0).AsUnsigned(); // Result is unit
}


/* Test for a directory. */
Handle isDir(TaskData *taskData, Handle name)
{
    TempString cDirName(name->Word());
    if (cDirName == 0) raise_syscall(taskData, "Insufficient memory", NOMEMORY);
    DWORD dwRes = GetFileAttributes(cDirName);
    if (dwRes == 0xFFFFFFFF)
        raise_syscall(taskData, "GetFileAttributes failed", GetLastError());
    if (dwRes & FILE_ATTRIBUTE_DIRECTORY)
        return Make_fixed_precision(taskData, 1);
    else return Make_fixed_precision(taskData, 0);
}

/* Get absolute canonical path name. */
Handle fullPath(TaskData *taskData, Handle filename)
{
    TempString cFileName;

    /* Special case of an empty string. */
    if (PolyStringLength(filename->Word()) == 0) cFileName = _tcsdup(_T("."));
    else cFileName = Poly_string_to_T_alloc(filename->Word());
    if (cFileName == 0) raise_syscall(taskData, "Insufficient memory", NOMEMORY);

    // Get the length
    DWORD dwRes = GetFullPathName(cFileName, 0, NULL, NULL);
    if (dwRes == 0)
        raise_syscall(taskData, "GetFullPathName failed", GetLastError());
    TempString resBuf((TCHAR*)malloc(dwRes * sizeof(TCHAR)));
    if (resBuf == 0) raise_syscall(taskData, "Insufficient memory", NOMEMORY);
    // When the length is enough the result is the length excluding the null
    DWORD dwRes1 = GetFullPathName(cFileName, dwRes, resBuf, NULL);
    if (dwRes1 == 0 || dwRes1 >= dwRes)
        raise_syscall(taskData, "GetFullPathName failed", GetLastError());
    /* Check that the file exists.  GetFullPathName doesn't do that. */
    dwRes = GetFileAttributes(resBuf);
    if (dwRes == 0xffffffff)
        raise_syscall(taskData, "File does not exist", FILEDOESNOTEXIST);
    return(SAVE(C_string_to_Poly(taskData, resBuf)));
}

/* Get file modification time.  This returns the value in the
   time units and from the base date used by timing.c. c.f. filedatec */
Handle modTime(TaskData *taskData, Handle filename)
{
    TempString cFileName(filename->Word());
    if (cFileName == 0) raise_syscall(taskData, "Insufficient memory", NOMEMORY);
    /* There are two ways to get this information.
        We can either use GetFileTime if we are able
        to open the file for reading but if it is locked
        we won't be able to.  FindFirstFile is the other
        alternative.  We have to check that the file name
        does not contain '*' or '?' otherwise it will try
        to "glob" this, which isn't what we want here. */
    WIN32_FIND_DATA wFind;
    HANDLE hFind;
    const TCHAR *p;
    for(p = cFileName; *p; p++)
        if (*p == '*' || *p == '?')
            raise_syscall(taskData, "Invalid filename", STREAMCLOSED);
    hFind = FindFirstFile(cFileName, &wFind);
    if (hFind == INVALID_HANDLE_VALUE)
        raise_syscall(taskData, "FindFirstFile failed", GetLastError());
    FindClose(hFind);
    return Make_arb_from_Filetime(taskData, wFind.ftLastWriteTime);
}

/* Get file size. */
Handle fileSize(TaskData *taskData, Handle filename)
{
    TempString cFileName(filename->Word());
    if (cFileName == 0) raise_syscall(taskData, "Insufficient memory", NOMEMORY);
    /* Similar to modTime*/
    WIN32_FIND_DATA wFind;
    HANDLE hFind;
    const TCHAR *p;
    for(p = cFileName; *p; p++)
        if (*p == '*' || *p == '?')
            raise_syscall(taskData, "Invalid filename", STREAMCLOSED);
    hFind = FindFirstFile(cFileName, &wFind);
    if (hFind == INVALID_HANDLE_VALUE)
        raise_syscall(taskData, "FindFirstFile failed", GetLastError());
    FindClose(hFind);
    return Make_arb_from_32bit_pair(taskData, wFind.nFileSizeHigh, wFind.nFileSizeLow);
}

/* Set file modification and access times. */
Handle setTime(TaskData *taskData, Handle fileName, Handle fileTime)
{
    TempString cFileName(fileName->Word());
    if (cFileName == 0) raise_syscall(taskData, "Insufficient memory", NOMEMORY);

    // The only way to set the time is to open the file and use SetFileTime.
    FILETIME ft;
    /* Get the file time. */
    getFileTimeFromArb(taskData, fileTime, &ft);
    /* Open an existing file with write access. We need that
        for SetFileTime. */
    HANDLE hFile = CreateFile(cFileName, GENERIC_WRITE, 0, NULL, OPEN_EXISTING,
                FILE_ATTRIBUTE_NORMAL, NULL);
    if (hFile == INVALID_HANDLE_VALUE)
        raise_syscall(taskData, "CreateFile failed", GetLastError());
    /* Set the file time. */
    if (!SetFileTime(hFile, NULL, &ft, &ft))
    {
        int nErr = GetLastError();
        CloseHandle(hFile);
        raise_syscall(taskData, "SetFileTime failed", nErr);
    }
    CloseHandle(hFile);
    return Make_fixed_precision(taskData, 0);
}

/* Rename a file. */
Handle renameFile(TaskData *taskData, Handle oldFileName, Handle newFileName)
{
    TempString oldName(oldFileName->Word()), newName(newFileName->Word());
    if (oldName == 0 || newName == 0) raise_syscall(taskData, "Insufficient memory", NOMEMORY);
    if (! MoveFileEx(oldName, newName, MOVEFILE_REPLACE_EXISTING))
        raise_syscall(taskData, "MoveFileEx failed", GetLastError());
    return Make_fixed_precision(taskData, 0);
}

/* Access right requests passed in from ML. */
#define FILE_ACCESS_READ    1
#define FILE_ACCESS_WRITE   2
#define FILE_ACCESS_EXECUTE 4

/* Get access rights to a file. */
Handle fileAccess(TaskData *taskData, Handle name, Handle rights)
{
    TempString fileName(name->Word());
    if (fileName == 0) raise_syscall(taskData, "Insufficient memory", NOMEMORY);
    int rts = get_C_int(taskData, DEREFWORD(rights));

    /* Test whether the file is read-only.  This is, of course,
        not what was asked but getting anything more is really
        quite complicated.  I don't see how we can find out if
        a file is executable (maybe check if the extension is
        .exe, .com or .bat?).  It would be possible, in NT, to
        examine the access structures but that seems far too
        complicated.  Leave it for the moment. */
    DWORD dwRes = GetFileAttributes(fileName);
    if (dwRes == 0xffffffff)
        return Make_fixed_precision(taskData, 0);
    /* If we asked for write access but it is read-only we
        return false. */
    if ((dwRes & FILE_ATTRIBUTE_READONLY) &&
        (rts & FILE_ACCESS_WRITE))
        return Make_fixed_precision(taskData, 0);
    else return Make_fixed_precision(taskData, 1);
}



/* IO_dispatchc.  Called from assembly code module. */
static Handle IO_dispatch_c(TaskData *taskData, Handle args, Handle strm, Handle code)
{
    unsigned c = get_C_unsigned(taskData, DEREFWORD(code));
    switch (c)
    {
    case 0: // Return standard input. 
        // This and the next two are normally only called once during start-up.
        // The exception is when we build the basis library during bootstrap.
        // We need to maintain the invariant that each WinStream object is referenced
        // by precisely one volatile word in order to be able to delete it when we close it.
    {
        if (standardInputValue != 0) return taskData->saveVec.push(standardInputValue);
        Handle stdStrm = MakeVolatileWord(taskData, standardInput);
        standardInputValue = stdStrm->WordP();
        return stdStrm;
    }
    case 1: // Return standard output
    {
        if (standardOutputValue != 0) return taskData->saveVec.push(standardOutputValue);
        Handle stdStrm = MakeVolatileWord(taskData, standardOutput);
        standardOutputValue = stdStrm->WordP();
        return stdStrm;
    }
    case 2: // Return standard error
    {
        if (standardErrorValue != 0) return taskData->saveVec.push(standardErrorValue);
        Handle stdStrm = MakeVolatileWord(taskData, standardError);
        standardErrorValue = stdStrm->WordP();
        return stdStrm;
    }
    case 3: /* Open file for text input. */
        return openWinFile(taskData, args, OPENREAD, false, false);
    case 4: /* Open file for binary input. */
        return openWinFile(taskData, args, OPENREAD, false, true);
    case 5: /* Open file for text output. */
        return openWinFile(taskData, args, OPENWRITE, false, false);
    case 6: /* Open file for binary output. */
        return openWinFile(taskData, args, OPENWRITE, false, true);
    case 13: /* Open text file for appending. */
             /* The IO library definition leaves it open whether this
             should use "append mode" or not.  */
        return openWinFile(taskData, args, OPENWRITE, true, false);
    case 14: /* Open binary file for appending. */
        return openWinFile(taskData, args, OPENWRITE, true, true);
    case 7: /* Close file */
    {
        // During the bootstrap we will have old format references.
        if (strm->Word().IsTagged())
            return Make_fixed_precision(taskData, 0);
        WinStream *stream = *(WinStream **)(strm->WordP());
        // May already have been closed.
        if (stream != 0)
        {
            try {
                stream->closeEntry(taskData);
                delete(stream);
                *(WinStream **)(strm->WordP()) = 0;
            }
            catch (...) {
                // If there was an error and we've raised an exception.
                delete(stream);
                *(WinStream **)(strm->WordP()) = 0;
                throw;
            }
        }
        return Make_fixed_precision(taskData, 0);
    }
    case 8: /* Read text into an array. */
        return readArray(taskData, strm, args, true);
    case 9: /* Read binary into an array. */
        return readArray(taskData, strm, args, false);
    case 10: /* Get text as a string. */
        return readString(taskData, strm, args, true);
    case 11: /* Write from memory into a text file. */
        return writeArray(taskData, strm, args, true);
    case 12: /* Write from memory into a binary file. */
        return writeArray(taskData, strm, args, false);
    case 15: /* Return recommended buffer size. */
             // This is a guess but 4k seems reasonable.
        return Make_fixed_precision(taskData, 4096);

    case 16: /* See if we can get some input. */
    {
        WinStream *stream = *(WinStream **)(strm->WordP());
        if (stream == 0) raise_syscall(taskData, "Stream is closed", STREAMCLOSED);
        return Make_fixed_precision(taskData, stream->isAvailable(taskData) ? 1 : 0);
    }

    case 17: // Return the number of bytes available. PrimIO.avail.
    {
        WinStream *stream = *(WinStream**)(strm->WordP());
        if (stream == 0) raise_syscall(taskData, "Stream is closed", STREAMCLOSED);
        uint64_t endOfStream = stream->fileSize(taskData); // May raise an exception if this isn't a file.
        uint64_t current = stream->getPos(taskData);
        return Make_fixed_precision(taskData, endOfStream - current);
    }

    case 18: // Get position on stream.  PrimIO.getPos
    {
        WinStream *stream = *(WinStream**)(strm->WordP());
        if (stream == 0) raise_syscall(taskData, "Stream is closed", STREAMCLOSED);
        // Get the current position in the stream.  This is used to test
        // for the availability of random access so it should raise an
        // exception if setFilePos or endFilePos would fail. 
        return Make_arbitrary_precision(taskData, stream->getPos(taskData));
    }

    case 19: // Seek to position on stream.  PrimIO.setPos
    {
        WinStream *stream = *(WinStream**)(strm->WordP());
        if (stream == 0) raise_syscall(taskData, "Stream is closed", STREAMCLOSED);
        // TODO: This doesn't necessarily return a 64-bit value.
        uint64_t position = (uint64_t)getPolyUnsigned(taskData, DEREFWORD(args));
        stream->setPos(taskData, position);
        return Make_arbitrary_precision(taskData, 0);
    }

    case 20: // Return position at end of stream.  PrimIO.endPos.
    {
        WinStream *stream = *(WinStream**)(strm->WordP());
        if (stream == 0) raise_syscall(taskData, "Stream is closed", STREAMCLOSED);
        return Make_arbitrary_precision(taskData, stream->fileSize(taskData));
    }

    case 21: /* Get the kind of device underlying the stream. */
    {
        WinStream *stream = *(WinStream**)(strm->WordP());
        if (stream == 0) raise_syscall(taskData, "Stream is closed", STREAMCLOSED);
        return Make_fixed_precision(taskData, stream->fileKind());
    }
    case 22: /* Return the polling options allowed on this descriptor. */
        return pollTest(taskData, strm);
    case 23: /* Poll the descriptor, waiting forever. */
        return pollDescriptors(taskData, args, 1);
    case 24: /* Poll the descriptor, waiting for the time requested. */
        return pollDescriptors(taskData, args, 0);
    case 25: /* Poll the descriptor, returning immediately.*/
        return pollDescriptors(taskData, args, 2);
    case 26: /* Get binary as a vector. */
        return readString(taskData, strm, args, false);

    case 27: /* Block until input is available. */
    {
        WinStream *stream = *(WinStream **)(strm->WordP());
        if (stream == 0) raise_syscall(taskData, "Stream is closed", STREAMCLOSED);
        // We should check for interrupts even if we're not going to block.
        processes->TestAnyEvents(taskData);
        stream->waitUntilAvailable(taskData);
        return Make_fixed_precision(taskData, 0);
    }

    case 28: /* Test whether output is possible. */
    {
        WinStream *stream = *(WinStream **)(strm->WordP());
        if (stream == 0) raise_syscall(taskData, "Stream is closed", STREAMCLOSED);
        return Make_fixed_precision(taskData, stream->canOutput(taskData) ? 1 : 0);
    }

    case 29: /* Block until output is possible. */
    {
        WinStream *stream = *(WinStream **)(strm->WordP());
        if (stream == 0) raise_syscall(taskData, "Stream is closed", STREAMCLOSED);
        // We should check for interrupts even if we're not going to block.
        processes->TestAnyEvents(taskData);
        stream->waitUntilOutputPossible(taskData);
        return Make_fixed_precision(taskData, 0);
    }

    /* Directory functions. */
    case 50: /* Open a directory. */
        return openDirectory(taskData, args);

    case 51: /* Read a directory entry. */
        return readDirectory(taskData, strm);

    case 52: /* Close the directory */
        return closeDirectory(taskData, strm);

    case 53: /* Rewind the directory. */
        return rewindDirectory(taskData, strm, args);

    case 54: /* Get current working directory. */
    {
        DWORD space = GetCurrentDirectory(0, NULL);
        if (space == 0)
            raise_syscall(taskData, "GetCurrentDirectory failed", GetLastError());
        TempString buff((TCHAR*)malloc(space * sizeof(TCHAR)));
        if (buff == 0) raise_syscall(taskData, "Insufficient memory", NOMEMORY);
        if (GetCurrentDirectory(space, buff) == 0)
            raise_syscall(taskData, "GetCurrentDirectory failed", GetLastError());
        return SAVE(C_string_to_Poly(taskData, buff));
    }

    case 55: /* Create a new directory. */
    {
        TempString dirName(args->Word());
        if (dirName == 0) raise_syscall(taskData, "Insufficient memory", NOMEMORY);
        if (!CreateDirectory(dirName, NULL))
            raise_syscall(taskData, "CreateDirectory failed", GetLastError());
        return Make_fixed_precision(taskData, 0);
    }

    case 56: /* Delete a directory. */
    {
        TempString dirName(args->Word());
        if (dirName == 0) raise_syscall(taskData, "Insufficient memory", NOMEMORY);
        if (!RemoveDirectory(dirName))
            raise_syscall(taskData, "RemoveDirectory failed", GetLastError());
        return Make_fixed_precision(taskData, 0);
    }

    case 57: /* Test for directory. */
        return isDir(taskData, args);

    case 58: /* Test for symbolic link. */
    {
        TempString fileName(args->Word());
        if (fileName == 0) raise_syscall(taskData, "Insufficient memory", NOMEMORY);
        DWORD dwRes = GetFileAttributes(fileName);
        if (dwRes == 0xFFFFFFFF)
            raise_syscall(taskData, "GetFileAttributes failed", GetLastError());
        return Make_fixed_precision(taskData, (dwRes & FILE_ATTRIBUTE_REPARSE_POINT) ? 1 : 0);
    }

    case 59: /* Read a symbolic link. */
    {
        // Windows has added symbolic links but reading the target is far from
        // straightforward.   It's probably not worth trying to implement this.
        raise_syscall(taskData, "Symbolic links are not implemented", 0);
        return taskData->saveVec.push(TAGGED(0)); /* To keep compiler happy. */
    }

    case 60: /* Return the full absolute path name. */
        return fullPath(taskData, args);

    case 61: /* Modification time. */
        return modTime(taskData, args);

    case 62: /* File size. */
        return fileSize(taskData, args);

    case 63: /* Set file time. */
        return setTime(taskData, strm, args);

    case 64: /* Delete a file. */
    {
        TempString fileName(args->Word());
        if (fileName == 0) raise_syscall(taskData, "Insufficient memory", NOMEMORY);
        if (!DeleteFile(fileName))
            raise_syscall(taskData, "DeleteFile failed", GetLastError());
        return Make_fixed_precision(taskData, 0);
    }

    case 65: /* rename a file. */
        return renameFile(taskData, strm, args);

    case 66: /* Get access rights. */
        return fileAccess(taskData, strm, args);

    case 67: /* Return a temporary file name. */
    {
        DWORD dwSpace = GetTempPath(0, NULL);
        if (dwSpace == 0)
            raise_syscall(taskData, "GetTempPath failed", GetLastError());
        TempString buff((TCHAR*)malloc((dwSpace + 12) * sizeof(TCHAR)));
        if (buff == 0) raise_syscall(taskData, "Insufficient memory", NOMEMORY);
        if (GetTempPath(dwSpace, buff) == 0)
            raise_syscall(taskData, "GetTempPath failed", GetLastError());
        lstrcat(buff, _T("MLTEMPXXXXXX"));
#if (defined(HAVE_MKSTEMP) && ! defined(UNICODE))
        // mkstemp is present in the Mingw64 headers but only as ANSI not Unicode.
        // Set the umask to mask out access by anyone else.
        // mkstemp generally does this anyway.
        mode_t oldMask = umask(0077);
        int fd = mkstemp(buff);
        int wasError = ERRORNUMBER;
        (void)umask(oldMask);
        if (fd != -1) close(fd);
        else raise_syscall(taskData, "mkstemp failed", wasError);
#else
        if (_tmktemp(buff) == 0)
            raise_syscall(taskData, "mktemp failed", ERRORNUMBER);
        int fd = _topen(buff, O_RDWR | O_CREAT | O_EXCL, 00600);
        if (fd != -1) close(fd);
        else raise_syscall(taskData, "Temporary file creation failed", ERRORNUMBER);
#endif
        Handle res = SAVE(C_string_to_Poly(taskData, buff));
        return res;
    }

    case 68: /* Get the file id. */
    {
        /* This concept does not exist in Windows. */
        /* Return a negative number. This is interpreted
        as "not implemented". */
        return Make_fixed_precision(taskData, -1);
    }

    case 69:
    {
        // Return an index for a token.  It is used in OS.IO.hash.
        // This is supposed to be well distributed for any 2^n but simply return
        // the low order part of the object address.
        WinStream *stream = *(WinStream **)(strm->WordP());
        if (stream == 0) raise_syscall(taskData, "Stream is closed", STREAMCLOSED);
        return Make_fixed_precision(taskData, (POLYUNSIGNED)((uintptr_t)(stream)) & 0xfffffff);
    }

    default:
    {
        char msg[100];
        sprintf(msg, "Unknown io function: %d", c);
        raise_exception_string(taskData, EXC_Fail, msg);
        return 0;
    }
    }
}

// General interface to IO.  Ideally the various cases will be made into
// separate functions.
POLYUNSIGNED PolyBasicIOGeneral(PolyObject *threadId, PolyWord code, PolyWord strm, PolyWord arg)
{
    TaskData *taskData = TaskData::FindTaskForId(threadId);
    ASSERT(taskData != 0);
    taskData->PreRTSCall();
    Handle reset = taskData->saveVec.mark();
    Handle pushedCode = taskData->saveVec.push(code);
    Handle pushedStrm = taskData->saveVec.push(strm);
    Handle pushedArg = taskData->saveVec.push(arg);
    Handle result = 0;

    try {
        result = IO_dispatch_c(taskData, pushedArg, pushedStrm, pushedCode);
    }
    catch (KillException &) {
        processes->ThreadExit(taskData); // TestAnyEvents may test for kill
    }
    catch (...) {} // If an ML exception is raised

    taskData->saveVec.reset(reset);
    taskData->PostRTSCall();
    if (result == 0) return TAGGED(0).AsUnsigned();
    else return result->Word().AsUnsigned();
}

struct _entrypts basicIOEPT[] =
{
    { "PolyChDir",                      (polyRTSFunction)&PolyChDir },
    { "PolyBasicIOGeneral",             (polyRTSFunction)&PolyBasicIOGeneral },

    { NULL, NULL } // End of list.
};

class WinBasicIO : public RtsModule
{
public:
    virtual void Start(void);
    virtual void GarbageCollect(ScanAddress * /*process*/);
};

// Declare this.  It will be automatically added to the table.
static WinBasicIO basicIOModule;

void WinBasicIO::Start(void)
{
}

void WinBasicIO::GarbageCollect(ScanAddress *process)
{
    if (standardInputValue != 0)
        process->ScanRuntimeAddress(&standardInputValue, ScanAddress::STRENGTH_STRONG);
    if (standardOutputValue != 0)
        process->ScanRuntimeAddress(&standardOutputValue, ScanAddress::STRENGTH_STRONG);
    if (standardErrorValue != 0)
        process->ScanRuntimeAddress(&standardErrorValue, ScanAddress::STRENGTH_STRONG);
}