lib/os_files.c

   1 /* File: "os_files.c" */
   2
   3 /* Copyright (c) 1994-2011 by Marc Feeley, All Rights Reserved. */
   4
   5 /*
   6  * This module implements the operating system specific routines
   7  * related to the file system.
   8  */
   9
  10 #define ___INCLUDED_FROM_OS_FILES
  11 #define ___VERSION 406003
  12 #include "gambit.h"
  13
  14 #include "os_base.h"
  15 #include "os_shell.h"
  16 #include "os_files.h"
  17 #include "setup.h"
  18
  19
  20 /*---------------------------------------------------------------------------*/
  21
  22
  23 ___files_module ___files_mod =
  24 {
  25   0
  26
  27 #ifdef ___FILES_MODULE_INIT
  28   ___FILES_MODULE_INIT
  29 #endif
  30 };
  31
  32
  33 /*---------------------------------------------------------------------------*/
  34
  35 #ifdef USE_CLASSIC_MACOS
  36
  37
  38 /* String conversion utilities. */
  39
  40 ___HIDDEN Boolean c2pascal
  41    ___P((char *cstr,
  42          StringPtr pstr,
  43          int max_length),
  44         (cstr,
  45          pstr,
  46          max_length)
  47 char *cstr;
  48 StringPtr pstr;
  49 int max_length;)
  50 {
  51   StringPtr p1 = pstr+1;
  52   char *p2 = cstr;
  53   while (max_length > 0 && *p2 != '\0')
  54     {
  55        *p1++ = *p2++;
  56        max_length--;
  57     }
  58   if (*p2 != '\0')
  59     return 0;
  60   else
  61     {
  62       pstr[0] = p2-cstr;
  63       return 1;
  64     }
  65 }
  66
  67
  68 ___HIDDEN Boolean pascal2c
  69    ___P((StringPtr pstr,
  70          char *cstr,
  71          int max_length),
  72         (pstr,
  73          cstr,
  74          max_length)
  75 StringPtr pstr;
  76 char *cstr;
  77 int max_length;)
  78 {
  79   char *p1 = cstr;
  80   StringPtr p2 = pstr+1;
  81   int len = pstr[0];
  82   if (len > max_length)
  83     return 0;
  84   else
  85     {
  86       while (len-- > 0)
  87         *p1++ = *p2++;
  88       *p1++ = '\0';
  89       return 1;
  90     }
  91 }
  92
  93
  94 #define DIR_SEPARATOR1 ':'
  95 #define PARENT_HOP ":"
  96
  97 #define DIR_SEPARATOR(c)((c) == DIR_SEPARATOR1)
  98 #define SEPARATOR(c)DIR_SEPARATOR(c)
  99
 100
 101 ___HIDDEN OSErr make_ResolvedFSSpec
 102    ___P((short vol,
 103          long dir,
 104          ConstStr255Param path,
 105          FSSpec *spec),
 106         (vol,
 107          dir,
 108          path,
 109          spec)
 110 short vol;
 111 long dir;
 112 ConstStr255Param path;
 113 FSSpec *spec;)
 114 {
 115   OSErr err;
 116   Str255 name;
 117   StringPtr start = ___CAST(StringPtr,path+1);
 118   StringPtr end = start + path[0];
 119   StringPtr p1 = start;
 120   StringPtr p2 = name+1;
 121   CInfoPBRec pb;
 122   Boolean is_folder;
 123   Boolean is_aliased;
 124
 125   if (!has_AliasMgr)
 126     return unimpErr;
 127
 128   spec->vRefNum = vol;
 129   spec->parID = dir;
 130
 131   do
 132     {
 133       p2 = name+1;
 134       while (p1 < end && DIR_SEPARATOR(*p1))  /* copy leading ':'s */
 135         *p2++ = *p1++;
 136       while (p1 < end && !DIR_SEPARATOR(*p1)) /* copy name that follows */
 137         *p2++ = *p1++;
 138       if (p1 < end && DIR_SEPARATOR(*p1))     /* end with a ':' if folder */
 139         *p2++ = DIR_SEPARATOR1;
 140       name[0] = p2 - (name+1);
 141
 142       err = FSMakeFSSpec (spec->vRefNum, spec->parID, name, spec);
 143       if (err == fnfErr && p1 == end)
 144         return noErr;
 145       if (err != noErr)
 146         return err;
 147
 148       if ((err = ResolveAliasFile (spec, 1, &is_folder, &is_aliased)) != noErr)
 149         return err;
 150       if (is_folder)
 151         {
 152           pb.dirInfo.ioNamePtr = spec->name;
 153           pb.dirInfo.ioVRefNum = spec->vRefNum;
 154           pb.dirInfo.ioDrDirID = spec->parID;
 155           pb.dirInfo.ioFDirIndex = 0;
 156           if ((err = PBGetCatInfoSync (&pb)) != noErr)
 157             return err;
 158           spec->parID = pb.hFileInfo.ioDirID;
 159           spec->name[0] = 0;
 160         }
 161       else if (p1 < end)
 162         return dirNFErr;
 163     } while (p1 < end);
 164
 165   return noErr;
 166 }
 167
 168
 169 ___HIDDEN OSErr ResolvedFSSpec_to_fullpath
 170    ___P((FSSpec *spec,
 171          StringPtr fullpath),
 172         (spec,
 173          fullpath)
 174 FSSpec *spec;
 175 StringPtr fullpath;)
 176 {
 177   OSErr err;
 178   int i;
 179   Str255 result;
 180   StringPtr p = result + sizeof(result);
 181   CInfoPBRec pb;
 182   Str31 name;
 183
 184   for (i = spec->name[0]; i > 0; i--)
 185     *--p = spec->name[i];
 186
 187   pb.dirInfo.ioNamePtr = name;
 188   pb.dirInfo.ioVRefNum = spec->vRefNum;
 189   pb.dirInfo.ioDrParID = spec->parID;
 190   pb.dirInfo.ioFDirIndex = -1;
 191
 192   do
 193     {
 194       pb.dirInfo.ioDrDirID = pb.dirInfo.ioDrParID;
 195       if ((err = PBGetCatInfoSync (&pb)) != noErr)
 196         return err;
 197       if (p-name[0]-1 < result)
 198         return bdNamErr; /* file name is too long */
 199       *--p = DIR_SEPARATOR1;
 200       for (i = name[0]; i > 0; i--)
 201         *--p = name[i];
 202     } while (pb.dirInfo.ioDrDirID != fsRtDirID);
 203
 204   i = result + sizeof(result) - p;
 205   *fullpath++ = i;
 206   while (i > 0)
 207     {
 208       *fullpath++ = *p++;
 209       i--;
 210     }
 211
 212   return noErr;
 213 }
 214
 215
 216 ___HIDDEN ___SCMOBJ path_expand_to_absolute
 217    ___P((char *path,
 218          char *directory,/******************* currently ignored*/
 219          char *new_path,
 220          long max_length),
 221         (path,
 222          directory,
 223          new_path,
 224          max_length)
 225 char *path;
 226 char *directory;
 227 char *new_path;
 228 long max_length;)
 229 {
 230   ___BOOL result = 0;
 231   FSSpec spec;
 232   short vol;
 233   long dir;
 234   char tmp[___PATH_MAX_LENGTH+1];
 235   Str255 ppath;
 236
 237   if (path[0] == '~')
 238     {
 239       if (path[1] == '~')
 240         {
 241           /* "~~" or "~~:xxx..." */
 242
 243           int i = 0;
 244           int j = 0;
 245           int sep = 0;
 246           char *tilde_dir;
 247
 248           if (!has_FindFolder)
 249             goto ret;
 250
 251           if (path[2]!='\0' && !DIR_SEPARATOR(path[2]))
 252             goto ret;
 253
 254           tilde_dir = ___setup_params.gambcdir;
 255           if (tilde_dir == 0)
 256 #ifdef ___GAMBCDIR
 257             tilde_dir = ___GAMBCDIR;
 258 #else
 259             tilde_dir = ":Gambit-C";
 260 #endif
 261
 262           i += 2;
 263
 264           while (*tilde_dir != '\0')
 265             if (j < ___PATH_MAX_LENGTH)
 266               {
 267                 tmp[j] = *tilde_dir++;
 268                 j++;
 269               }
 270             else
 271               goto ret;
 272
 273           while (path[i] != '\0')
 274             if (j < ___PATH_MAX_LENGTH)
 275               {
 276                 if (DIR_SEPARATOR(path[i]))
 277                   sep = 1;
 278                 tmp[j++] = path[i++];
 279               }
 280             else
 281               goto ret;
 282
 283           if (!sep)
 284             if (j < ___PATH_MAX_LENGTH)
 285               tmp[j++] = DIR_SEPARATOR1;
 286             else
 287               goto ret;
 288
 289           tmp[j] = '\0';
 290           path = tmp;
 291
 292           if (FindFolder (kOnSystemDisk,
 293                           kPreferencesFolderType,
 294                           0,
 295                           &vol,
 296                           &dir)
 297               != noErr)
 298             goto ret;
 299         }
 300       else if (path[1]!='\0' && !DIR_SEPARATOR(path[1]))
 301         {
 302           /* "~user" or "~user:xxx..." */
 303
 304           goto ret; /* no equivalent on Macintosh */
 305         }
 306       else
 307         {
 308           /* "~" or "~:xxx..." */
 309
 310           path++;
 311           vol = 0; /* use default volume and directory
 312                       (folder containing application) */
 313           dir = 0;
 314         }
 315     }
 316   else
 317     {
 318       vol = 0; /* use default volume and directory
 319                   (folder containing application) */
 320       dir = 0;
 321     }
 322
 323   if (!c2pascal (path, ppath, 255) ||
 324       make_ResolvedFSSpec (vol, dir, ppath, &spec) != noErr ||
 325       ResolvedFSSpec_to_fullpath (&spec, ppath) != noErr ||
 326       !pascal2c (ppath, new_path, max_length))
 327     goto ret;
 328
 329   result = 1;
 330
 331  ret:
 332
 333   return result;
 334 }
 335
 336
 337 ___HIDDEN OSErr copy_file_sectors
 338    ___P((short src_refnum,
 339          short dst_refnum),
 340         (src_refnum,
 341          dst_refnum)
 342 short src_refnum;
 343 short dst_refnum;)
 344 {
 345   OSErr err1, err2;
 346   char buf[2048];
 347   long count1, count2;
 348
 349   do
 350     {
 351       count1 = sizeof (buf);
 352       err1 = FSRead (src_refnum, &count1, buf);
 353       if (err1 != noErr && err1 != eofErr)
 354         return err1;
 355       count2 = count1;
 356       err2 = FSWrite (dst_refnum, &count2, buf);
 357       if (err2 != noErr || count1 != count2)
 358         return err2;
 359     } while (err1 != eofErr);
 360
 361   return noErr;
 362 }
 363
 364
 365 ___HIDDEN OSErr copy_file
 366    ___P((FSSpec src_spec,
 367          FSSpec dst_spec),
 368         (src_spec,
 369          dst_spec)
 370 FSSpec src_spec;
 371 FSSpec dst_spec;)
 372 {
 373   OSErr err, err2;
 374   short src_refnum, dst_refnum;
 375   FInfo src_info;
 376
 377   if (((err = FSpDelete (&dst_spec)) == noErr || err == fnfErr) &&
 378       (err = FSpGetFInfo (&src_spec, &src_info)) == noErr &&
 379       (err = FSpCreate (&dst_spec, 0x3f3f3f3f, 0x3f3f3f3f, 0)) == noErr)
 380     {
 381       src_info.fdFlags = src_info.fdFlags & ~kHasBeenInited;
 382       if ((err = FSpSetFInfo (&dst_spec, &src_info) == noErr) &&
 383           (err = FSpOpenRF (&src_spec, fsRdPerm, &src_refnum) == noErr))
 384         {
 385           if ((err = FSpOpenRF (&dst_spec, fsWrPerm, &dst_refnum)) == noErr)
 386             {
 387               err = copy_file_sectors (src_refnum, dst_refnum);
 388               err2 = FSClose (dst_refnum);
 389               if (err == noErr)
 390                 err = err2;
 391             }
 392           err2 = FSClose (src_refnum);
 393           if (err == noErr)
 394             err = err2;
 395           if (err == noErr &&
 396               (err = FSpOpenDF (&src_spec, fsRdPerm, &src_refnum) == noErr))
 397             {
 398               if ((err = FSpOpenDF (&dst_spec, fsWrPerm, &dst_refnum)) == noErr)
 399                 {
 400                   err = copy_file_sectors (src_refnum, dst_refnum);
 401                   err2 = FSClose (dst_refnum);
 402                   if (err == noErr)
 403                     err = err2;
 404                 }
 405               err2 = FSClose (src_refnum);
 406               if (err == noErr)
 407                 err = err2;
 408             }
 409         }
 410       if (err != noErr)
 411         FSpDelete (&dst_spec);
 412     }
 413
 414   return err;
 415 }
 416
 417
 418 #endif
 419
 420
 421 /*---------------------------------------------------------------------------*/
 422
 423 /* Filesystem path expansion. */
 424
 425
 426 ___SCMOBJ ___os_path_homedir ___PVOID
 427 {
 428   ___SCMOBJ e;
 429   ___SCMOBJ result;
 430   ___UCS_2STRING cstr1;
 431
 432   static ___UCS_2 cvar1[] =
 433   { 'H', 'O', 'M', 'E', '\0' };
 434
 435   if ((e = ___getenv_UCS_2 (cvar1, &cstr1)) != ___FIX(___NO_ERR))
 436     result = e;
 437   else
 438     {
 439       if (cstr1 != 0)
 440         {
 441           if ((e = ___UCS_2STRING_to_SCMOBJ
 442                      (cstr1,
 443                       &result,
 444                       ___RETURN_POS))
 445               != ___FIX(___NO_ERR))
 446             result = e;
 447           else
 448             ___release_scmobj (result);
 449
 450           ___free_mem (cstr1);
 451         }
 452       else
 453         {
 454 #ifdef USE_WIN32
 455
 456           ___CHAR_TYPE(___PATH_CE_SELECT) homedir[___PATH_MAX_LENGTH+1];
 457           int len = ___PATH_MAX_LENGTH+1;
 458           int n;
 459
 460           static ___CHAR_TYPE(___GETENV_CE_SELECT) cvar2[] =
 461           { 'H', 'O', 'M', 'E', 'D', 'R', 'I', 'V', 'E', '\0' };
 462
 463           static ___CHAR_TYPE(___GETENV_CE_SELECT) cvar3[] =
 464           { 'H', 'O', 'M', 'E', 'P', 'A', 'T', 'H', '\0' };
 465
 466           n = GetEnvironmentVariable (cvar2, homedir, len);
 467
 468           if (n > 0 && n < len)
 469             {
 470               len -= n;
 471
 472               n = GetEnvironmentVariable (cvar3, homedir+n, len);
 473
 474               if (n > 0 && n < len)
 475                 {
 476                   if ((e = ___NONNULLSTRING_to_SCMOBJ
 477                              (homedir,
 478                               &result,
 479                               ___RETURN_POS,
 480                               ___CE(___PATH_CE_SELECT)))
 481                       != ___FIX(___NO_ERR))
 482                     result = e;
 483                   else
 484                     ___release_scmobj (result);
 485                 }
 486               else
 487                 result = ___FAL;
 488             }
 489           else
 490             result = ___FAL;
 491
 492 #else
 493
 494           result = ___FAL;
 495
 496 #endif
 497         }
 498     }
 499
 500   return result;
 501 }
 502
 503
 504 ___SCMOBJ ___os_path_gambcdir ___PVOID
 505 {
 506   ___SCMOBJ e;
 507   ___SCMOBJ result;
 508
 509 #ifdef USE_WIN32
 510 #ifndef ___GAMBCDIR
 511 #ifdef USE_GetModuleFileName
 512   if (___setup_params.gambcdir == 0)
 513     {
 514       ___CHAR_TYPE(___PATH_CE_SELECT) temp[___PATH_MAX_LENGTH+1];
 515       DWORD n;
 516
 517       n = GetModuleFileName (NULL, temp, ___PATH_MAX_LENGTH+1);
 518       if (n > 0)
 519         {
 520           int cch;
 521           ___UCS_2STRING gambcdir = 0;
 522           /* remove filename */
 523           *(_tcsrchr (temp, '\\')) = 0;
 524           /* remove bin subdirectory, if present */
 525           cch = _tcslen (temp);
 526           if (cch > 7) /* e.g. C:\x\bin */
 527             {
 528               if (0 == _tcsicmp (temp+cch-4, _T("\\bin")))
 529                 {
 530                   cch -= 4;
 531                   *(temp+cch) = '\0';
 532                 }
 533             }
 534
 535           gambcdir = ___CAST(___UCS_2STRING,
 536                              ___alloc_mem ((cch+1) * sizeof (___UCS_2)));
 537
 538           if (gambcdir == 0)
 539             {
 540               e = ___FIX(___HEAP_OVERFLOW_ERR);
 541               return e;
 542             }
 543           else
 544             {
 545 #ifdef _UNICODE
 546               _tcscpy (gambcdir, temp);
 547 #else
 548               mbstowcs (gambcdir, temp, cch);
 549               gambcdir[cch] = '\0';
 550 #endif
 551               ___setup_params.gambcdir = gambcdir;
 552             }
 553       }
 554   }
 555 #endif
 556 #endif
 557 #endif
 558
 559   if (___setup_params.gambcdir != 0)
 560     {
 561       if ((e = ___NONNULLUCS_2STRING_to_SCMOBJ
 562                  (___setup_params.gambcdir,
 563                   &result,
 564                   ___RETURN_POS))
 565           != ___FIX(___NO_ERR))
 566         result = e;
 567       else
 568         ___release_scmobj (result);
 569     }
 570   else
 571     {
 572
 573 #ifndef ___GAMBCDIR
 574
 575 #define STRINGIFY1(x) #x
 576 #define STRINGIFY2(x) STRINGIFY1(x)
 577
 578 #ifdef USE_POSIX
 579 #define ___GAMBCDIR "/usr/local/Gambit-C/" STRINGIFY2(___VERSION)
 580 #endif
 581
 582 #ifdef USE_WIN32
 583 /* Will only be used if GetModuleFileName path fails */
 584 #define ___GAMBCDIR "c:\\Gambit-C\\" STRINGIFY2(___VERSION)
 585 #endif
 586
 587 #ifdef USE_CLASSIC_MACOS
 588 #define ___GAMBCDIR ":Gambit-C:" STRINGIFY2(___VERSION)
 589 #endif
 590
 591 #endif
 592
 593       if ((e = ___NONNULLCHARSTRING_to_SCMOBJ
 594                  (___GAMBCDIR,
 595                   &result,
 596                   ___RETURN_POS))
 597           != ___FIX(___NO_ERR))
 598         result = e;
 599       else
 600         ___release_scmobj (result);
 601     }
 602
 603   return result;
 604 }
 605
 606
 607 #ifndef ___GAMBCDIR_MAP_CE_SELECT
 608 #define ___GAMBCDIR_MAP_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native) ucs2
 609 #endif
 610
 611 #ifndef ___CONFIG_GAMBCDIR_MAP_CE_SELECT
 612 #define ___CONFIG_GAMBCDIR_MAP_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native) native
 613 #endif
 614
 615
 616 /*
 617  * TODO: the current implementation of the lookup duplicates the
 618  * lookup logic because the configuration map and the map from the
 619  * runtime options are not represented with the same string type.  The
 620  * proper approach would be to represent OS environment variables
 621  * using UTF-8 strings, but this would require substantial changes.
 622  */
 623
 624
 625 ___HIDDEN ___STRING_TYPE(___GAMBCDIR_MAP_CE_SELECT) gambcdir_map_lookup
 626    ___P((___STRING_TYPE(___GAMBCDIR_MAP_CE_SELECT) d),
 627         (d)
 628 ___STRING_TYPE(___GAMBCDIR_MAP_CE_SELECT) d;)
 629 {
 630   ___STRING_TYPE(___GAMBCDIR_MAP_CE_SELECT) dir;
 631   ___STRING_TYPE(___GAMBCDIR_MAP_CE_SELECT) *p = ___setup_params.gambcdir_map;
 632
 633   if (p == 0)
 634     return 0;
 635
 636   while ((dir = *p++) != 0)
 637     {
 638       int i = 0;
 639       for (;;)
 640         {
 641           ___UCS_2 c = d[i];
 642           if (c == '\0')
 643             {
 644               if (dir[i] == '=')
 645                 return dir+i+1;
 646               else
 647                 break;
 648             }
 649           else if ((dir[i] == '=') || (dir[i] != c))
 650             {
 651               break;
 652             }
 653           i++;
 654         }
 655     }
 656
 657   return 0;
 658 }
 659
 660
 661 ___HIDDEN ___STRING_TYPE(___CONFIG_GAMBCDIR_MAP_CE_SELECT) config_gambcdir_map[] =
 662 {
 663 #ifdef ___GAMBCDIR_BIN
 664   "bin=" ___GAMBCDIR_BIN,
 665 #endif
 666 #ifdef ___GAMBCDIR_DOC
 667   "doc=" ___GAMBCDIR_DOC,
 668 #endif
 669 #ifdef ___GAMBCDIR_INCLUDE
 670   "include=" ___GAMBCDIR_INCLUDE,
 671 #endif
 672 #ifdef ___GAMBCDIR_INFO
 673   "info=" ___GAMBCDIR_INFO,
 674 #endif
 675 #ifdef ___GAMBCDIR_LIB
 676   "lib=" ___GAMBCDIR_LIB,
 677 #endif
 678 #ifdef ___GAMBCDIR_SHARE
 679   "share=" ___GAMBCDIR_SHARE,
 680 #endif
 681   0
 682 };
 683
 684
 685 ___HIDDEN ___STRING_TYPE(___CONFIG_GAMBCDIR_MAP_CE_SELECT) config_gambcdir_map_lookup
 686    ___P((___STRING_TYPE(___GAMBCDIR_MAP_CE_SELECT) d),
 687         (d)
 688 ___STRING_TYPE(___GAMBCDIR_MAP_CE_SELECT) d;)
 689 {
 690   ___STRING_TYPE(___CONFIG_GAMBCDIR_MAP_CE_SELECT) dir;
 691   ___STRING_TYPE(___CONFIG_GAMBCDIR_MAP_CE_SELECT) *p = config_gambcdir_map;
 692
 693   while ((dir = *p++) != 0)
 694     {
 695       int i = 0;
 696       for (;;)
 697         {
 698           ___UCS_2 c = d[i];
 699           if (c == '\0')
 700             {
 701               if (dir[i] == '=')
 702                 return dir+i+1;
 703               else
 704                 break;
 705             }
 706           else if ((dir[i] == '=') || (dir[i] != c))
 707             {
 708               break;
 709             }
 710           i++;
 711         }
 712     }
 713
 714   return 0;
 715 }
 716
 717
 718 ___SCMOBJ ___os_path_gambcdir_map_lookup
 719    ___P((___SCMOBJ dir),
 720         (dir)
 721 ___SCMOBJ dir;)
 722 {
 723   ___SCMOBJ e;
 724   ___SCMOBJ result;
 725   void *cdir;
 726
 727   if ((e = ___SCMOBJ_to_STRING
 728              (dir,
 729               &cdir,
 730               1,
 731               ___CE(___GAMBCDIR_MAP_CE_SELECT),
 732               0))
 733       != ___FIX(___NO_ERR))
 734     result = e;
 735   else
 736     {
 737       ___STRING_TYPE(___GAMBCDIR_MAP_CE_SELECT) d =
 738         ___CAST(___STRING_TYPE(___GAMBCDIR_MAP_CE_SELECT),cdir);
 739
 740       ___STRING_TYPE(___GAMBCDIR_MAP_CE_SELECT) dir1;
 741       ___STRING_TYPE(___CONFIG_GAMBCDIR_MAP_CE_SELECT) dir2;
 742
 743       if ((dir1 = gambcdir_map_lookup (d)) != 0)
 744         {
 745           if ((e = ___STRING_to_SCMOBJ
 746                      (dir1,
 747                       &result,
 748                       ___RETURN_POS,
 749                       ___CE(___GAMBCDIR_MAP_CE_SELECT)))
 750               != ___FIX(___NO_ERR))
 751             result = e;
 752           else
 753             ___release_scmobj (result);
 754         }
 755       else if ((dir2 = config_gambcdir_map_lookup (d)) != 0)
 756         {
 757           if ((e = ___STRING_to_SCMOBJ
 758                      (dir2,
 759                       &result,
 760                       ___RETURN_POS,
 761                       ___CE(___CONFIG_GAMBCDIR_MAP_CE_SELECT)))
 762               != ___FIX(___NO_ERR))
 763             result = e;
 764           else
 765             ___release_scmobj (result);
 766         }
 767       else
 768         result = ___FAL;
 769
 770       ___release_string (cdir);
 771     }
 772
 773   return result;
 774 }
 775
 776
 777 ___SCMOBJ ___os_path_normalize_directory
 778    ___P((___SCMOBJ path),
 779         (path)
 780 ___SCMOBJ path;)
 781 {
 782   ___SCMOBJ e;
 783   ___SCMOBJ result;
 784   void *cpath;
 785
 786   if ((e = ___SCMOBJ_to_STRING
 787              (path,
 788               &cpath,
 789               1,
 790               ___CE(___PATH_CE_SELECT),
 791               0))
 792       != ___FIX(___NO_ERR))
 793     result = e;
 794   else
 795     {
 796       ___STRING_TYPE(___PATH_CE_SELECT) p =
 797         ___CAST(___STRING_TYPE(___PATH_CE_SELECT),cpath);
 798       ___STRING_TYPE(___PATH_CE_SELECT) dir;
 799
 800 #ifndef USE_POSIX
 801 #ifndef USE_WIN32
 802
 803       ___CHAR_TYPE(___PATH_CE_SELECT) normalized_dir[___PATH_MAX_LENGTH+1+1];
 804       ___FILE *exist_check;
 805
 806       dir = normalized_dir;
 807
 808       if (p == 0)
 809         p = ".";
 810
 811       while (*p != '\0')
 812         *dir++ = *p++;
 813
 814       if (dir == normalized_dir || dir[-1] != '/')
 815         *dir++ = '/';
 816
 817       *dir++ = '\0';
 818
 819       dir = normalized_dir;
 820
 821       while (dir[0] == '.' && dir[1] == '/' && dir[2] != '\0')
 822         dir += 2;
 823
 824       exist_check = ___fopen (dir, "r");
 825
 826       if (exist_check == 0)
 827         result = fnf_or_err_code_from_errno ();
 828       else
 829         {
 830           ___fclose (exist_check);
 831
 832           if ((e = ___NONNULLSTRING_to_SCMOBJ
 833                      (dir,
 834                       &result,
 835                       ___RETURN_POS,
 836                       ___CE(___PATH_CE_SELECT)))
 837               != ___FIX(___NO_ERR))
 838             result = e;
 839           else
 840             ___release_scmobj (result);
 841         }
 842
 843 #endif
 844 #endif
 845
 846 #ifdef USE_POSIX
 847
 848       ___CHAR_TYPE(___PATH_CE_SELECT) old_dir[___PATH_MAX_LENGTH+1+1];
 849       ___CHAR_TYPE(___PATH_CE_SELECT) normalized_dir[___PATH_MAX_LENGTH+1+1];
 850
 851       dir = normalized_dir;
 852
 853       if (getcwd (old_dir, ___PATH_MAX_LENGTH) == 0)
 854         e = err_code_from_errno ();
 855       else
 856         {
 857           if (p == 0)
 858             dir = old_dir;
 859           else
 860             {
 861               if (chdir (p) < 0)
 862                 e = err_code_from_errno ();
 863               else
 864                 {
 865                   if (getcwd (normalized_dir, ___PATH_MAX_LENGTH) == 0)
 866                     e = err_code_from_errno ();
 867                   else
 868                     e = ___FIX(___NO_ERR);
 869                 }
 870               chdir (old_dir); /* ignore error */
 871             }
 872         }
 873
 874       if (e != ___FIX(___NO_ERR))
 875         result = e;
 876       else
 877         {
 878           p = dir;
 879
 880           while (*p != '\0')
 881             p++;
 882
 883           if (p == dir || p[-1] != '/')
 884             {
 885               *p++ = '/';
 886               *p++ = '\0';
 887             }
 888
 889           if ((e = ___NONNULLSTRING_to_SCMOBJ
 890                      (dir,
 891                       &result,
 892                       ___RETURN_POS,
 893                       ___CE(___PATH_CE_SELECT)))
 894               != ___FIX(___NO_ERR))
 895             result = e;
 896           else
 897             ___release_scmobj (result);
 898         }
 899
 900 #endif
 901
 902 #ifdef USE_WIN32
 903
 904       ___CHAR_TYPE(___PATH_CE_SELECT) old_dir[___PATH_MAX_LENGTH+1+1];
 905       ___CHAR_TYPE(___PATH_CE_SELECT) normalized_dir[___PATH_MAX_LENGTH+1+1];
 906       DWORD n;
 907
 908       dir = normalized_dir;
 909
 910       n = GetCurrentDirectory (___PATH_MAX_LENGTH+1,
 911                                old_dir);
 912
 913       if (n < 1 || n > ___PATH_MAX_LENGTH)
 914         e = err_code_from_GetLastError ();
 915       else
 916         {
 917           if (p == 0)
 918             dir = old_dir;
 919           else
 920             {
 921               if (!SetCurrentDirectory (p))
 922                 e = err_code_from_GetLastError ();
 923               else
 924                 {
 925                   n = GetCurrentDirectory (___PATH_MAX_LENGTH+1,
 926                                            normalized_dir);
 927
 928                   if (n < 1 || n > ___PATH_MAX_LENGTH)
 929                     e = err_code_from_GetLastError ();
 930
 931                   SetCurrentDirectory (old_dir); /* ignore error */
 932                 }
 933             }
 934         }
 935
 936       if (e != ___FIX(___NO_ERR))
 937         result = e;
 938       else
 939         {
 940           p = dir;
 941
 942           while (*p != '\0')
 943             p++;
 944
 945           if (p == dir || (p[-1] != '\\' && p[-1] != '/'))
 946             {
 947               *p++ = '\\';
 948               *p++ = '\0';
 949             }
 950
 951           if ((e = ___NONNULLSTRING_to_SCMOBJ
 952                      (dir,
 953                       &result,
 954                       ___RETURN_POS,
 955                       ___CE(___PATH_CE_SELECT)))
 956               != ___FIX(___NO_ERR))
 957             result = e;
 958           else
 959             ___release_scmobj (result);
 960         }
 961
 962 #endif
 963
 964       ___release_string (cpath);
 965     }
 966
 967   return result;
 968 }
 969
 970
 971 /*---------------------------------------------------------------------------*/
 972
 973 /* File system operations. */
 974
 975
 976 ___SCMOBJ ___os_create_directory
 977    ___P((___SCMOBJ path,
 978          ___SCMOBJ mode),
 979         (path,
 980          mode)
 981 ___SCMOBJ path;
 982 ___SCMOBJ mode;)
 983 {
 984   ___SCMOBJ e;
 985   void *cpath;
 986
 987 #ifndef USE_mkdir
 988 #ifndef USE_CreateDirectory
 989
 990   e = ___FIX(___UNIMPL_ERR);
 991
 992 #endif
 993 #endif
 994
 995 #ifdef USE_mkdir
 996
 997 #define ___CREATE_DIRECTORY_PATH_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native) native
 998
 999   if ((e = ___SCMOBJ_to_NONNULLSTRING
1000              (path,
1001               &cpath,
1002               1,
1003               ___CE(___CREATE_DIRECTORY_PATH_CE_SELECT),
1004               0))
1005       == ___FIX(___NO_ERR))
1006     {
1007       if (mkdir (___CAST(___STRING_TYPE(___CREATE_DIRECTORY_PATH_CE_SELECT),cpath), ___INT(mode)) < 0)
1008         e = fnf_or_err_code_from_errno ();
1009       ___release_string (cpath);
1010     }
1011
1012 #endif
1013
1014 #ifdef USE_CreateDirectory
1015
1016 #ifdef _UNICODE
1017 #define ___CREATE_DIRECTORY_PATH_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native) ucs2
1018 #else
1019 #define ___CREATE_DIRECTORY_PATH_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native) native
1020 #endif
1021
1022   if ((e = ___SCMOBJ_to_NONNULLSTRING
1023              (path,
1024               &cpath,
1025               1,
1026               ___CE(___CREATE_DIRECTORY_PATH_CE_SELECT),
1027               0))
1028       == ___FIX(___NO_ERR))
1029     {
1030       if (!CreateDirectory
1031             (___CAST(___STRING_TYPE(___CREATE_DIRECTORY_PATH_CE_SELECT),
1032                      cpath),
1033              NULL))
1034         e = fnf_or_err_code_from_GetLastError ();
1035       ___release_string (cpath);
1036     }
1037
1038 #endif
1039
1040   return e;
1041 }
1042
1043
1044 ___SCMOBJ ___os_create_fifo
1045    ___P((___SCMOBJ path,
1046          ___SCMOBJ mode),
1047         (path,
1048          mode)
1049 ___SCMOBJ path;
1050 ___SCMOBJ mode;)
1051 {
1052   ___SCMOBJ e;
1053   void *cpath;
1054
1055 #ifndef USE_mkfifo
1056
1057   e = ___FIX(___UNIMPL_ERR);
1058
1059 #endif
1060
1061 #ifdef USE_mkfifo
1062
1063 #define ___CREATE_FIFO_PATH_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native) native
1064
1065   if ((e = ___SCMOBJ_to_NONNULLSTRING
1066              (path,
1067               &cpath,
1068               1,
1069               ___CE(___CREATE_FIFO_PATH_CE_SELECT),
1070               0))
1071       == ___FIX(___NO_ERR))
1072     {
1073       if (mkfifo (___CAST(___STRING_TYPE(___CREATE_FIFO_PATH_CE_SELECT),cpath), ___INT(mode)) < 0)
1074         e = fnf_or_err_code_from_errno ();
1075       ___release_string (cpath);
1076     }
1077
1078 #endif
1079
1080   return e;
1081 }
1082
1083
1084 ___SCMOBJ ___os_create_link
1085    ___P((___SCMOBJ path1,
1086          ___SCMOBJ path2),
1087         (path1,
1088          path2)
1089 ___SCMOBJ path1;
1090 ___SCMOBJ path2;)
1091 {
1092   ___SCMOBJ e;
1093   void *cpath1;
1094   void *cpath2;
1095
1096 #ifndef USE_link
1097
1098   e = ___FIX(___UNIMPL_ERR);
1099
1100 #endif
1101
1102 #ifdef USE_link
1103
1104 #define ___CREATE_LINK_PATH_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native) native
1105
1106   if ((e = ___SCMOBJ_to_NONNULLSTRING
1107              (path1,
1108               &cpath1,
1109               1,
1110               ___CE(___CREATE_LINK_PATH_CE_SELECT),
1111               0))
1112       == ___FIX(___NO_ERR))
1113     {
1114       if ((e = ___SCMOBJ_to_NONNULLSTRING
1115                  (path2,
1116                   &cpath2,
1117                   2,
1118                   ___CE(___CREATE_LINK_PATH_CE_SELECT),
1119                   0))
1120           == ___FIX(___NO_ERR))
1121         {
1122           if (link (___CAST(___STRING_TYPE(___CREATE_LINK_PATH_CE_SELECT),cpath1),
1123                     ___CAST(___STRING_TYPE(___CREATE_LINK_PATH_CE_SELECT),cpath2))
1124               < 0)
1125             e = fnf_or_err_code_from_errno ();
1126           ___release_string (cpath2);
1127         }
1128       ___release_string (cpath1);
1129     }
1130
1131 #endif
1132
1133   return e;
1134 }
1135
1136
1137 ___SCMOBJ ___os_create_symbolic_link
1138    ___P((___SCMOBJ path1,
1139          ___SCMOBJ path2),
1140         (path1,
1141          path2)
1142 ___SCMOBJ path1;
1143 ___SCMOBJ path2;)
1144 {
1145   ___SCMOBJ e;
1146   void *cpath1;
1147   void *cpath2;
1148
1149 #ifndef USE_symlink
1150
1151   e = ___FIX(___UNIMPL_ERR);
1152
1153 #endif
1154
1155 #ifdef USE_symlink
1156
1157 #define ___CREATE_SYMLINK_PATH_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native) native
1158
1159   if ((e = ___SCMOBJ_to_NONNULLSTRING
1160              (path1,
1161               &cpath1,
1162               1,
1163               ___CE(___CREATE_SYMLINK_PATH_CE_SELECT),
1164               0))
1165       == ___FIX(___NO_ERR))
1166     {
1167       if ((e = ___SCMOBJ_to_NONNULLSTRING
1168                  (path2,
1169                   &cpath2,
1170                   2,
1171                   ___CE(___CREATE_SYMLINK_PATH_CE_SELECT),
1172                   0))
1173           == ___FIX(___NO_ERR))
1174         {
1175           if (symlink (___CAST(___STRING_TYPE(___CREATE_SYMLINK_PATH_CE_SELECT),cpath1),
1176                        ___CAST(___STRING_TYPE(___CREATE_SYMLINK_PATH_CE_SELECT),cpath2))
1177               < 0)
1178             e = fnf_or_err_code_from_errno ();
1179           ___release_string (cpath2);
1180         }
1181       ___release_string (cpath1);
1182     }
1183
1184 #endif
1185
1186   return e;
1187 }
1188
1189
1190 ___SCMOBJ ___os_delete_directory
1191    ___P((___SCMOBJ path),
1192         (path)
1193 ___SCMOBJ path;)
1194 {
1195   ___SCMOBJ e;
1196   void *cpath;
1197
1198 #ifndef USE_rmdir
1199 #ifndef USE_RemoveDirectory
1200
1201   e = ___FIX(___UNIMPL_ERR);
1202
1203 #endif
1204 #endif
1205
1206 #ifdef USE_rmdir
1207
1208 #define ___DELETE_DIRECTORY_PATH_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native) native
1209
1210   if ((e = ___SCMOBJ_to_NONNULLSTRING
1211              (path,
1212               &cpath,
1213               1,
1214               ___CE(___DELETE_DIRECTORY_PATH_CE_SELECT),
1215               0))
1216       == ___FIX(___NO_ERR))
1217     {
1218       if (rmdir (___CAST(___STRING_TYPE(___DELETE_DIRECTORY_PATH_CE_SELECT),cpath)) < 0)
1219         e = fnf_or_err_code_from_errno ();
1220       ___release_string (cpath);
1221     }
1222
1223 #endif
1224
1225 #ifdef USE_RemoveDirectory
1226
1227 #ifdef _UNICODE
1228 #define ___DELETE_DIRECTORY_PATH_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native) ucs2
1229 #else
1230 #define ___DELETE_DIRECTORY_PATH_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native) native
1231 #endif
1232
1233   if ((e = ___SCMOBJ_to_NONNULLSTRING
1234              (path,
1235               &cpath,
1236               1,
1237               ___CE(___DELETE_DIRECTORY_PATH_CE_SELECT),
1238               0))
1239       == ___FIX(___NO_ERR))
1240     {
1241       if (!RemoveDirectory
1242             (___CAST(___STRING_TYPE(___DELETE_DIRECTORY_PATH_CE_SELECT),
1243                      cpath)))
1244         e = fnf_or_err_code_from_GetLastError ();
1245       ___release_string (cpath);
1246     }
1247
1248 #endif
1249
1250   return e;
1251 }
1252
1253
1254 ___SCMOBJ ___os_set_current_directory
1255    ___P((___SCMOBJ path),
1256         (path)
1257 ___SCMOBJ path;)
1258 {
1259   ___SCMOBJ e;
1260   void *cpath;
1261
1262 #ifndef USE_chdir
1263 #ifndef USE_SetCurrentDirectory
1264
1265   e = ___FIX(___UNIMPL_ERR);
1266
1267 #endif
1268 #endif
1269
1270 #ifdef USE_chdir
1271
1272 #define ___SET_CURRENT_DIRECTORY_PATH_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native) native
1273
1274   if ((e = ___SCMOBJ_to_NONNULLSTRING
1275              (path,
1276               &cpath,
1277               1,
1278               ___CE(___SET_CURRENT_DIRECTORY_PATH_CE_SELECT),
1279               0))
1280       == ___FIX(___NO_ERR))
1281     {
1282       if (chdir (___CAST(___STRING_TYPE(___SET_CURRENT_DIRECTORY_PATH_CE_SELECT),cpath)) < 0)
1283         e = fnf_or_err_code_from_errno ();
1284       ___release_string (cpath);
1285     }
1286
1287 #endif
1288
1289 #ifdef USE_SetCurrentDirectory
1290
1291 #ifdef _UNICODE
1292 #define ___SET_CURRENT_DIRECTORY_PATH_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native) ucs2
1293 #else
1294 #define ___SET_CURRENT_DIRECTORY_PATH_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native) native
1295 #endif
1296
1297   if ((e = ___SCMOBJ_to_NONNULLSTRING
1298              (path,
1299               &cpath,
1300               1,
1301               ___CE(___SET_CURRENT_DIRECTORY_PATH_CE_SELECT),
1302               0))
1303       == ___FIX(___NO_ERR))
1304     {
1305       if (!SetCurrentDirectory
1306             (___CAST(___STRING_TYPE(___SET_CURRENT_DIRECTORY_PATH_CE_SELECT),
1307                      cpath)))
1308         e = fnf_or_err_code_from_GetLastError ();
1309       ___release_string (cpath);
1310     }
1311
1312 #endif
1313
1314   return e;
1315 }
1316
1317
1318 ___SCMOBJ ___os_rename_file
1319    ___P((___SCMOBJ path1,
1320          ___SCMOBJ path2),
1321         (path1,
1322          path2)
1323 ___SCMOBJ path1;
1324 ___SCMOBJ path2;)
1325 {
1326   ___SCMOBJ e;
1327   void *cpath1;
1328   void *cpath2;
1329
1330 #ifndef USE_rename
1331 #ifndef USE_MoveFile
1332
1333   e = ___FIX(___UNIMPL_ERR);
1334
1335 #endif
1336 #endif
1337
1338 #ifdef USE_rename
1339
1340 #define ___RENAME_FILE_PATH_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native) native
1341
1342   if ((e = ___SCMOBJ_to_NONNULLSTRING
1343              (path1,
1344               &cpath1,
1345               1,
1346               ___CE(___RENAME_FILE_PATH_CE_SELECT),
1347               0))
1348       == ___FIX(___NO_ERR))
1349     {
1350       if ((e = ___SCMOBJ_to_NONNULLSTRING
1351                  (path2,
1352                   &cpath2,
1353                   2,
1354                   ___CE(___RENAME_FILE_PATH_CE_SELECT),
1355                   0))
1356           == ___FIX(___NO_ERR))
1357         {
1358           if (rename (___CAST(___STRING_TYPE(___RENAME_FILE_PATH_CE_SELECT),cpath1),
1359                       ___CAST(___STRING_TYPE(___RENAME_FILE_PATH_CE_SELECT),cpath2))
1360               < 0)
1361             e = fnf_or_err_code_from_errno ();
1362           ___release_string (cpath2);
1363         }
1364       ___release_string (cpath1);
1365     }
1366
1367 #endif
1368
1369 #ifdef USE_MoveFile
1370
1371 #ifdef _UNICODE
1372 #define ___RENAME_FILE_PATH_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native) ucs2
1373 #else
1374 #define ___RENAME_FILE_PATH_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native) native
1375 #endif
1376
1377   if ((e = ___SCMOBJ_to_NONNULLSTRING
1378              (path1,
1379               &cpath1,
1380               1,
1381               ___CE(___RENAME_FILE_PATH_CE_SELECT),
1382               0))
1383       == ___FIX(___NO_ERR))
1384     {
1385       if ((e = ___SCMOBJ_to_NONNULLSTRING
1386                  (path2,
1387                   &cpath2,
1388                   2,
1389                   ___CE(___RENAME_FILE_PATH_CE_SELECT),
1390                   0))
1391           == ___FIX(___NO_ERR))
1392         {
1393           if (!MoveFile
1394                 (___CAST(___STRING_TYPE(___RENAME_FILE_PATH_CE_SELECT),
1395                          cpath1),
1396                  ___CAST(___STRING_TYPE(___RENAME_FILE_PATH_CE_SELECT),
1397                          cpath2)))
1398             e = fnf_or_err_code_from_GetLastError ();
1399           ___release_string (cpath2);
1400         }
1401       ___release_string (cpath1);
1402     }
1403
1404 #endif
1405
1406   return e;
1407 }
1408
1409
1410 ___SCMOBJ ___os_copy_file
1411    ___P((___SCMOBJ path1,
1412          ___SCMOBJ path2),
1413         (path1,
1414          path2)
1415 ___SCMOBJ path1;
1416 ___SCMOBJ path2;)
1417 {
1418   ___SCMOBJ e;
1419   void *cpath1;
1420   void *cpath2;
1421
1422 #ifndef USE_POSIX
1423 #ifndef USE_CopyFile
1424
1425   e = ___FIX(___UNIMPL_ERR);
1426
1427 #endif
1428 #endif
1429
1430 #ifdef USE_POSIX
1431
1432 #define ___COPY_FILE_PATH_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native) native
1433
1434   if ((e = ___SCMOBJ_to_NONNULLSTRING
1435              (path1,
1436               &cpath1,
1437               1,
1438               ___CE(___COPY_FILE_PATH_CE_SELECT),
1439               0))
1440       == ___FIX(___NO_ERR))
1441     {
1442       if ((e = ___SCMOBJ_to_NONNULLSTRING
1443                  (path2,
1444                   &cpath2,
1445                   2,
1446                   ___CE(___COPY_FILE_PATH_CE_SELECT),
1447                   0))
1448           == ___FIX(___NO_ERR))
1449         {
1450           int fd1;
1451           int fd2;
1452
1453           if ((fd1 = open (___CAST(___STRING_TYPE(___COPY_FILE_PATH_CE_SELECT),
1454                                    cpath1),
1455 #ifdef O_BINARY
1456                            O_BINARY|
1457 #endif
1458                            O_RDONLY,
1459                            0777)) < 0)
1460             e = fnf_or_err_code_from_errno ();
1461           else
1462             {
1463               if ((fd2 = open (___CAST(___STRING_TYPE(___COPY_FILE_PATH_CE_SELECT),
1464                                        cpath2),
1465 #ifdef O_BINARY
1466                                O_BINARY|
1467 #endif
1468                                O_WRONLY|O_CREAT|O_EXCL,
1469                                0777)) < 0)
1470                 e = fnf_or_err_code_from_errno ();
1471               else
1472                 {
1473                   char buffer[4096];
1474                   int nr;
1475                   int nw;
1476
1477                   for (;;)
1478                     {
1479                       nr = read (fd1, buffer, sizeof (buffer));
1480
1481                       if (nr == 0)
1482                         break;
1483
1484                       if (nr < 0 || (nw = write (fd2, buffer, nr)) < 0)
1485                         {
1486                           e = err_code_from_errno ();
1487                           break;
1488                         }
1489
1490                       if (nw != nr)
1491                         {
1492                           e = ___FIX(___UNKNOWN_ERR);
1493                           break;
1494                         }
1495                     }
1496
1497                   if (close (fd2) < 0 && e != ___FIX(___NO_ERR))
1498                     e = err_code_from_errno ();
1499                 }
1500
1501               if (close (fd1) < 0 && e != ___FIX(___NO_ERR))
1502                 {
1503                   e = err_code_from_errno ();
1504                   unlink (___CAST(___STRING_TYPE(___COPY_FILE_PATH_CE_SELECT),
1505                                   cpath2));
1506                 }
1507             }
1508           ___release_string (cpath2);
1509         }
1510       ___release_string (cpath1);
1511     }
1512
1513 #endif
1514
1515 #ifdef USE_CopyFile
1516
1517 #ifdef _UNICODE
1518 #define ___COPY_FILE_PATH_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native) ucs2
1519 #else
1520 #define ___COPY_FILE_PATH_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native) native
1521 #endif
1522
1523   if ((e = ___SCMOBJ_to_NONNULLSTRING
1524              (path1,
1525               &cpath1,
1526               1,
1527               ___CE(___COPY_FILE_PATH_CE_SELECT),
1528               0))
1529       == ___FIX(___NO_ERR))
1530     {
1531       if ((e = ___SCMOBJ_to_NONNULLSTRING
1532                  (path2,
1533                   &cpath2,
1534                   2,
1535                   ___CE(___COPY_FILE_PATH_CE_SELECT),
1536                   0))
1537           == ___FIX(___NO_ERR))
1538         {
1539           if (!CopyFile
1540                 (___CAST(___STRING_TYPE(___COPY_FILE_PATH_CE_SELECT),
1541                          cpath1),
1542                  ___CAST(___STRING_TYPE(___COPY_FILE_PATH_CE_SELECT),
1543                          cpath2),
1544                  1))
1545             e = fnf_or_err_code_from_GetLastError ();
1546           ___release_string (cpath2);
1547         }
1548       ___release_string (cpath1);
1549     }
1550
1551 #endif
1552
1553   return e;
1554 }
1555
1556
1557 ___SCMOBJ ___os_delete_file
1558    ___P((___SCMOBJ path),
1559         (path)
1560 ___SCMOBJ path;)
1561 {
1562   ___SCMOBJ e;
1563   void *cpath;
1564
1565 #ifndef USE_unlink
1566 #ifndef USE_DeleteFile
1567
1568   e = ___FIX(___UNIMPL_ERR);
1569
1570 #endif
1571 #endif
1572
1573 #ifdef USE_unlink
1574
1575 #define ___DELETE_FILE_PATH_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native) native
1576
1577   if ((e = ___SCMOBJ_to_NONNULLSTRING
1578              (path,
1579               &cpath,
1580               1,
1581               ___CE(___DELETE_FILE_PATH_CE_SELECT),
1582               0))
1583       == ___FIX(___NO_ERR))
1584     {
1585       if (unlink (___CAST(___STRING_TYPE(___DELETE_FILE_PATH_CE_SELECT),cpath))
1586           < 0)
1587         e = fnf_or_err_code_from_errno ();
1588       ___release_string (cpath);
1589     }
1590
1591 #endif
1592
1593 #ifdef USE_DeleteFile
1594
1595 #ifdef _UNICODE
1596 #define ___DELETE_FILE_PATH_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native) ucs2
1597 #else
1598 #define ___DELETE_FILE_PATH_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native) native
1599 #endif
1600
1601   if ((e = ___SCMOBJ_to_NONNULLSTRING
1602              (path,
1603               &cpath,
1604               1,
1605               ___CE(___DELETE_FILE_PATH_CE_SELECT),
1606               0))
1607       == ___FIX(___NO_ERR))
1608     {
1609       if (!DeleteFile
1610             (___CAST(___STRING_TYPE(___DELETE_FILE_PATH_CE_SELECT),
1611                      cpath)))
1612         e = fnf_or_err_code_from_GetLastError ();
1613       ___release_string (cpath);
1614     }
1615
1616 #endif
1617
1618   return e;
1619 }
1620
1621
1622 /*---------------------------------------------------------------------------*/
1623
1624 /* File system module initialization/finalization. */
1625
1626
1627 ___SCMOBJ ___setup_files_module ___PVOID
1628 {
1629   if (!___files_mod.setup)
1630     {
1631       ___files_mod.setup = 1;
1632       return ___FIX(___NO_ERR);
1633     }
1634
1635   return ___FIX(___UNKNOWN_ERR);
1636 }
1637
1638
1639 void ___cleanup_files_module ___PVOID
1640 {
1641   if (___files_mod.setup)
1642     {
1643       ___files_mod.setup = 0;
1644     }
1645 }
1646
1647
1648 /*---------------------------------------------------------------------------*/