stdlib/io.ajla

   1 {*
   2  * Copyright (C) 2024 Mikulas Patocka
   3  *
   4  * This file is part of Ajla.
   5  *
   6  * Ajla is free software: you can redistribute it and/or modify it under the
   7  * terms of the GNU General Public License as published by the Free Software
   8  * Foundation, either version 3 of the License, or (at your option) any later
   9  * version.
  10  *
  11  * Ajla is distributed in the hope that it will be useful, but WITHOUT ANY
  12  * WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  13  * A PARTICULAR PURPOSE. See the GNU General Public License for more details.
  14  *
  15  * You should have received a copy of the GNU General Public License along with
  16  * Ajla. If not, see <https://www.gnu.org/licenses/>.
  17  *}
  18
  19 unit io;
  20
  21 uses treemap;
  22
  23 {---------
  24  - WORLD -
  25  ---------}
  26
  27 type world;
  28
  29 private fn unsafe_get_world : world;
  30 fn recover_world(w old_w : world) : world;
  31 fn join(t : type, w1 w2 : t) : t;
  32 fn any~lazy(t1 t2 : type, w1 : t1, w2 : t2) : bool;
  33 fn any_list~lazy(t : type, wx : list(t)) : int;
  34 fn is_ready(t : type, v : t) : bool;
  35 fn never(t : type) : t;
  36 fn fork(t : type, w : t) : (t, t);
  37 fn atomic_enter~inline(w : world) : world;
  38 fn atomic_exit~inline(w : world) : world;
  39 fn exit(w : world, n : int) : world;
  40 fn exit_msg(w : world, n : int, m : bytes) : world;
  41
  42 {--------
  43  - ARGS -
  44  --------}
  45
  46 private fn get_args(w : world) : list(bytes);
  47
  48 {-------
  49  - I/O -
  50  -------}
  51
  52 type handle;
  53 type dhandle;
  54
  55 const open_flag_read : int;
  56 const open_flag_write : int;
  57 const open_flag_append : int;
  58 const open_flag_create : int;
  59 const open_flag_must_create : int;
  60 const open_flag_no_follow : int;
  61 const open_mode_ro_current_user : int;
  62 const open_mode_ro_all_users : int;
  63 const open_mode_rw_current_user : int;
  64 const open_mode_read_all_users : int;
  65 const open_mode_default : int;
  66
  67 fn ropen(w : world, d : dhandle, f : bytes, flags : int) : (world, handle);
  68 fn read(w : world, h : handle, size : int) : (world, bytes);
  69 fn read_partial(w : world, h : handle, size : int) : (world, bytes);
  70 fn wopen(w : world, d : dhandle, f : bytes, flags : int, mode : int) : (world, handle);
  71 fn write(w : world, h : handle, s : bytes) : world;
  72 fn wcontiguous(w : world, h : handle, size : int64) : world;
  73
  74 fn ropen_lazy(d : dhandle, f : bytes, flags : int) : handle;
  75 fn read_lazy~lazy(r : handle) : bytes;
  76
  77 private fn read_console_packet(w : world, h : handle) : (world, list(int32));
  78 private fn write_console_packet(w : world, h : handle, cp : list(int32)) : world;
  79
  80 fn pipe(w : world) : (world, handle, handle);
  81
  82 fn bopen(w : world, d : dhandle, f : bytes, flags : int, mode : int) : (world, handle);
  83 fn bread(w : world, h : handle, position : int64, size : int) : (world, bytes);
  84 fn bwrite(w : world, h : handle, position : int64, s : bytes) : world;
  85 fn bsize(w : world, h : handle) : (world, int64);
  86 fn bdata(w : world, h : handle, off : int64) : (world, int64);
  87 fn bhole(w : world, h : handle, off : int64) : (world, int64);
  88 fn bsetsize(w : world, h : handle, size : int64) : world;
  89 fn bcontiguous(w : world, h : handle, pos : int64, size : int64) : world;
  90 fn bclone(w : world, src_h : handle, src_pos : int64, dst_h : handle, dst_pos : int64, size : int64) : world;
  91 fn bopen_lazy(d : dhandle, f : bytes, flags : int) : handle;
  92 fn bread_lazy~lazy(h : handle, position : int64) : bytes;
  93 fn bsize_lazy(h : handle) : int64;
  94 fn bdata_lazy(h : handle, off : int64) : int64;
  95 fn bhole_lazy(h : handle, off : int64) : int64;
  96
  97 fn fdatasync(w : world, h : handle) : world;
  98 fn fsync(w : world, h : handle) : world;
  99 fn ffssync(w : world, h : handle) : world;
 100 fn sync(w : world) : world;
 101
 102 fn droot(w : world) : dhandle;
 103 private fn dcwd(w : world) : dhandle;
 104 private fn dlib(w : world) : dhandle;
 105 private fn dexe(w : world) : dhandle;
 106 fn dnone(w : world) : dhandle;
 107 private fn libpath : bytes;
 108 fn dopen(w : world, d : dhandle, f : bytes, flags : int) : (world, dhandle);
 109 fn dread(w : world, d : dhandle) : (world, list(bytes));
 110 fn dpath(w : world, d : dhandle) : (world, bytes);
 111 fn dopen_lazy(d : dhandle, f : bytes, flags : int) : dhandle;
 112 fn dread_lazy(d : dhandle) : list(bytes);
 113 fn dpath_lazy(d : dhandle) : bytes;
 114 fn dmonitor(w : world, d : dhandle) : (world, world);
 115
 116 const stat_flag_devmajor : int;
 117 const stat_flag_devminor : int;
 118 const stat_flag_inode : int;
 119 const stat_flag_type : int;
 120 const stat_flag_mode : int;
 121 const stat_flag_nlink : int;
 122 const stat_flag_uid : int;
 123 const stat_flag_gid : int;
 124 const stat_flag_rdevmajor : int;
 125 const stat_flag_rdevminor : int;
 126 const stat_flag_size : int;
 127 const stat_flag_optimaliosize : int;
 128 const stat_flag_allocated : int;
 129 const stat_flag_atime : int;
 130 const stat_flag_mtime : int;
 131 const stat_flag_ctime : int;
 132
 133 const stat_type_file : int;
 134 const stat_type_directory : int;
 135 const stat_type_link : int;
 136 const stat_type_fifo : int;
 137 const stat_type_chardev : int;
 138 const stat_type_blockdev : int;
 139 const stat_type_socket : int;
 140
 141 fn stat(w : world, d : dhandle, f : bytes, flags : int) : (world, list(int64));
 142 fn lstat(w : world, d : dhandle, f : bytes, flags : int) : (world, list(int64));
 143 fn fstat(w : world, h : handle, flags : int) : (world, list(int64));
 144
 145 fn stat_lazy(d : dhandle, f : bytes, flags : int) : list(int64);
 146 fn lstat_lazy(d : dhandle, f : bytes, flags : int) : list(int64);
 147 fn fstat_lazy(h : handle, flags : int) : list(int64);
 148
 149 const statfs_flag_bsize : int;
 150 const statfs_flag_frsize : int;
 151 const statfs_flag_frtotal : int;
 152 const statfs_flag_frfree : int;
 153 const statfs_flag_fravail : int;
 154 const statfs_flag_intotal : int;
 155 const statfs_flag_infree : int;
 156 const statfs_flag_inavail : int;
 157 const statfs_flag_fsid : int;
 158 const statfs_flag_flags : int;
 159 const statfs_flag_namelen : int;
 160
 161 const statfs_st_readonly : int;
 162 const statfs_st_nosuid : int;
 163 const statfs_st_nodev : int;
 164 const statfs_st_noexec : int;
 165 const statfs_st_synchronous : int;
 166 const statfs_st_mandlock : int;
 167 const statfs_st_noatime : int;
 168 const statfs_st_nodiratime : int;
 169 const statfs_st_relatime : int;
 170
 171 fn fstatfs(w : world, h : handle, flags : int) : (world, list(int64));
 172 fn dstatfs(w : world, d : dhandle, flags : int) : (world, list(int64));
 173
 174 fn readlink(w : world, d : dhandle, f : bytes) : (world, bytes);
 175 fn readlink_lazy(d : dhandle, f : bytes) : bytes;
 176
 177 fn unlink(w : world, d : dhandle, f : bytes) : world;
 178 fn rmdir(w : world, d : dhandle, f : bytes) : world;
 179 fn mkdir(w : world, d : dhandle, f : bytes, mode : int) : world;
 180 fn mkpipe(w : world, d : dhandle, f : bytes, mode : int) : world;
 181 fn mksocket(w : world, d : dhandle, f : bytes, mode : int) : world;
 182 fn mkchardev(w : world, d : dhandle, f : bytes, mode major minor : int) : world;
 183 fn mkblockdev(w : world, d : dhandle, f : bytes, mode major minor : int) : world;
 184 fn mksymlink(w : world, d : dhandle, f t : bytes) : world;
 185 fn mklink(w : world, d : dhandle, f : bytes, e : dhandle, t : bytes) : world;
 186 fn rename(w : world, d : dhandle, f : bytes, e : dhandle, t : bytes) : world;
 187 fn chmod(w : world, d : dhandle, f : bytes, m : int) : world;
 188 fn chown(w : world, d : dhandle, f : bytes, uid gid : int) : world;
 189 fn lchown(w : world, d : dhandle, f : bytes, uid gid : int) : world;
 190 fn utime(w : world, d : dhandle, f : bytes, atime mtime : int64) : world;
 191 fn lutime(w : world, d : dhandle, f : bytes, atime mtime : int64) : world;
 192
 193 const stty_flag_raw : int;
 194 const stty_flag_noecho : int;
 195 const stty_flag_nosignal : int;
 196 const stty_flag_nocrlf : int;
 197
 198 fn stty(w : world, h : handle, flags : int) : world;
 199 fn tty_size(w : world, h : handle, x y : int) : (world, int, int);
 200
 201 const uname_flag_ajla_version : int;
 202 const uname_flag_flavor : int;
 203 const uname_flag_system : int;
 204 const uname_flag_release : int;
 205 const uname_flag_version : int;
 206 const uname_flag_machine : int;
 207
 208 fn uname(flags : int) : list(bytes);
 209 fn get_host_name(w : world) : (world, bytes);
 210
 211 fn get_real_time(w : world) : (world, int64);
 212 fn get_monotonic_time(w : world) : (world, int64);
 213 fn sleep(t : type, w : t, tm : int64) : t;
 214
 215 {--------
 216  - PATH -
 217  --------}
 218
 219 const path_separator : byte;
 220 fn path_is_separator(b : byte) : bool;
 221 fn path_is_dir_separator(b : byte) : bool;
 222 fn path_compare(a b : bytes) : bool;
 223 fn path_is_absolute(p : bytes) : bool;
 224 fn path_is_root(p : bytes) : bool;
 225 fn path_to_dir_file(p : bytes) : (bytes, bytes);
 226 fn path_append(pd pf : bytes) : bytes;
 227 fn path_contract(p : bytes) : bytes;
 228 fn path_join(pd pf : bytes) : bytes;
 229 fn path_canonical(w : world, d : dhandle, p : bytes) : (world, bytes);
 230 fn path_get_cwd(implicit w : world, d : dhandle, env : treemap(bytes, bytes)) : (world, bytes);
 231 fn path_shortcut_home(home : maybe(bytes), p : bytes) : bytes;
 232 fn path_expand_home(home : maybe(bytes), p : bytes) : bytes;
 233 fn path_mkdir(w : world, d : dhandle, f : bytes, mode : int) : world;
 234 fn path_xdg(implicit w : world, env : treemap(bytes, bytes), xdg_env : bytes, deflt : bytes, appname : bytes) : (world, dhandle);
 235 fn path_config(w : world, env : treemap(bytes, bytes), appname : bytes) : (world, dhandle);
 236 fn path_write_atomic(w : world, d : dhandle, f : bytes, content : bytes) : world;
 237
 238 {----------------
 239  - DEPENDENCIES -
 240  ----------------}
 241
 242 fn register_dependence(w : world, d : dhandle, p : bytes) : world;
 243
 244
 245 implementation
 246
 247 uses pcode;
 248 uses exception;
 249
 250 {---------
 251  - WORLD -
 252  ---------}
 253
 254 option world [
 255         world;
 256 ]
 257
 258 fn unsafe_get_world : world
 259 [
 260         return world.world;
 261 ]
 262
 263 fn recover_world(w old_w : world) : world
 264 [
 265         if is_exception w then
 266                 return old_w;
 267         return w;
 268 ]
 269
 270 fn join(t : type, w1 w2 : t) : t
 271 [
 272         if is_exception w1 then [
 273                 eval w2;
 274                 return w1;
 275         ]
 276         if is_exception w2 then
 277                 return w2;
 278         return w1;
 279 ]
 280
 281 fn any~lazy(t1 t2 : type, w1 : t1, w2 : t2) : bool
 282 [
 283         var b : bool;
 284         pcode IO IO_Any 1 2 0 =b w1 w2;
 285         return b;
 286 ]
 287
 288 fn any_list~lazy(t : type, wx : list(t)) : int
 289 [
 290         if not len_greater_than(wx, 0) then
 291                 return never(int);
 292         var n := any_list~lazy(wx[1 .. ]);
 293         var b := any(wx[0], n);
 294         return select(b, 0, n + 1);
 295 ]
 296
 297 fn is_ready(t : type, v : t) : bool
 298 [
 299         return not any(v, unit_value);
 300 ]
 301
 302 fn never(t : type) : t
 303 [
 304         var w : t;
 305         pcode IO IO_Never 1 0 0 =w;
 306         return w;
 307 ]
 308
 309 fn fork(t : type, w : t) : (t, t)
 310 [
 311         var w1 w2 : t;
 312         pcode IO IO_Fork 2 1 0 =w1 =w2 w;
 313         return w1, w2;
 314 ]
 315
 316 fn atomic_enter~inline(w : world) : world
 317 [
 318         var w2 : world;
 319         pcode IO IO_Atomic_Enter 1 1 0 =w2 w;
 320         return w2;
 321 ]
 322
 323 fn atomic_exit~inline(w : world) : world
 324 [
 325         var w2 : world;
 326         pcode IO IO_Atomic_Exit 1 1 0 =w2 w;
 327         return w2;
 328 ]
 329
 330 fn exit(w : world, n : int) : world
 331 [
 332         var exc := exception_make(world, ec_exit, error_exit, n, false);
 333         return join(w, exc);
 334 ]
 335
 336 fn exit_msg(w : world, n : int, m : bytes) : world
 337 [
 338         var exc := exception_make_str(world, ec_exit, error_exit, n, false, m);
 339         return join(w, exc);
 340 ]
 341
 342 {--------
 343  - ARGS -
 344  --------}
 345
 346 fn get_args(w : world) : list(bytes)
 347 [
 348         var r : list(bytes);
 349         pcode IO IO_Get_Args 1 1 0 =r w;
 350         return r;
 351 ]
 352
 353 {-------
 354  - I/O -
 355  -------}
 356
 357 type handle := internal_type;
 358 type dhandle := internal_type;
 359
 360 const open_flag_read : int := IO_Open_Flag_Read;
 361 const open_flag_write : int := IO_Open_Flag_Write;
 362 const open_flag_append : int := IO_Open_Flag_Append;
 363 const open_flag_create : int := IO_Open_Flag_Create;
 364 const open_flag_must_create : int := IO_Open_Flag_Must_Create;
 365 const open_flag_no_follow : int := IO_Open_Flag_No_Follow;
 366 const open_mode_ro_current_user : int := #100;
 367 const open_mode_ro_all_users : int := #124;
 368 const open_mode_rw_current_user : int := #180;
 369 const open_mode_read_all_users : int := #1a4;
 370 const open_mode_default : int := #1b6;
 371
 372 fn ropen(w : world, d : dhandle, f : bytes, flags : int) : (world, handle)
 373 [
 374         var h : handle;
 375         var w2 : world;
 376         var mode := 0;
 377         pcode IO IO_Stream_Open_Read 2 5 0 =w2 =h w d f flags mode;
 378         return w2, h;
 379 ]
 380
 381 fn read(w : world, h : handle, size : int) : (world, bytes)
 382 [
 383         var read_so_far := 0;
 384         var s := bytes.[];
 385         while read_so_far < size do [
 386                 var s1 : bytes;
 387                 var w2 : world;
 388                 w2, s1 := read_partial~strict(w, h, size - read_so_far);
 389                 w := w2;
 390                 var l1 := len(s1);
 391                 if l1 = 0 then
 392                         break;
 393                 read_so_far += l1;
 394                 s += s1;
 395         ]
 396         return w, s;
 397 ]
 398
 399 fn read_partial(w : world, h : handle, size : int) : (world, bytes)
 400 [
 401         var s : bytes;
 402         var w2 : world;
 403         pcode IO IO_Stream_Read_Partial 2 3 0 =w2 =s w h size;
 404         return w2, s;
 405 ]
 406
 407 fn wopen(w : world, d : dhandle, f : bytes, flags : int, mode : int) : (world, handle)
 408 [
 409         var h : handle;
 410         var w2 : world;
 411         pcode IO IO_Stream_Open_Write 2 5 0 =w2 =h w d f flags mode;
 412         return w2, h;
 413 ]
 414
 415 fn write(w : world, h : handle, s : bytes) : world
 416 [
 417         while len_greater_than(byte, s, 0) do [
 418                 var sz : int;
 419                 var w2 : world;
 420                 pcode IO IO_Stream_Write 2 3 0 =w2 =sz w h s;
 421                 w := w2;
 422                 s := s[sz .. ];
 423         ]
 424         return w;
 425 ]
 426
 427 fn wcontiguous(implicit w : world, h : handle, size : int64) : world
 428 [
 429         var offset := bsize(h);
 430         bcontiguous(w, h, offset, size);
 431 ]
 432
 433 fn ropen_lazy(d : dhandle, f : bytes, flags : int) : handle
 434 [
 435         var h : handle;
 436         var w := unsafe_get_world;
 437         w, h := ropen(w, d, f, flags);
 438         return h;
 439 ]
 440
 441 fn read_lazy~lazy(r : handle) : bytes
 442 [
 443         var b : bytes;
 444         var w := unsafe_get_world;
 445         w, b := read_partial~strict(w, r, 16384);
 446         if len(b) = 0 then
 447                 return b;
 448         return b + read_lazy(r);
 449 ]
 450
 451 fn read_console_packet(w : world, h : handle) : (world, list(int32))
 452 [
 453         var cp : list(int32);
 454         var w2 : world;
 455         pcode IO IO_Read_Console_Packet 2 2 0 =w2 =cp w h;
 456         return w2, cp;
 457 ]
 458
 459 fn write_console_packet(w : world, h : handle, cp : list(int32)) : world
 460 [
 461         var w2 : world;
 462         pcode IO IO_Write_Console_Packet 1 3 0 =w2 w h cp;
 463         return w2;
 464 ]
 465
 466 fn pipe(w : world) : (world, handle, handle)
 467 [
 468         var rh : handle, wh : handle;
 469         var w2 : world;
 470         pcode IO IO_Pipe 3 1 0 =w2 =rh =wh w;
 471         return w2, rh, wh;
 472 ]
 473
 474 fn bopen(w : world, d : dhandle, f : bytes, flags : int, mode : int) : (world, handle)
 475 [
 476         var h : handle;
 477         var w2 : world;
 478         pcode IO IO_Block_Open 2 5 0 =w2 =h w d f flags mode;
 479         return w2, h;
 480 ]
 481
 482 fn bread(w : world, h : handle, position : int64, size : int) : (world, bytes)
 483 [
 484         var s : bytes;
 485         var w2 : world;
 486         pcode IO IO_Block_Read 2 4 0 =w2 =s w h size position;
 487         return w2, s;
 488 ]
 489
 490 fn bwrite(w : world, h : handle, position : int64, s : bytes) : world
 491 [
 492         while len_greater_than(byte, s, 0) do [
 493                 var sz : int;
 494                 var w2 : world;
 495                 pcode IO IO_Block_Write 2 4 0 =w2 =sz w h s position;
 496                 s := s[sz .. ];
 497                 w := w2;
 498                 position += sz;
 499         ]
 500         return w;
 501 ]
 502
 503 fn bsize(w : world, h : handle) : (world, int64)
 504 [
 505         var sz : int64;
 506         var w2 : world;
 507         var off : int64 := 0;
 508         pcode IO IO_LSeek 2 3 1 =w2 =sz w h off 2;
 509         return w2, sz;
 510 ]
 511
 512 fn bdata(w : world, h : handle, off : int64) : (world, int64)
 513 [
 514         var sz : int64;
 515         var w2 : world;
 516         pcode IO IO_LSeek 2 3 1 =w2 =sz w h off 3;
 517         return w2, sz;
 518 ]
 519
 520 fn bhole(w : world, h : handle, off : int64) : (world, int64)
 521 [
 522         var sz : int64;
 523         var w2 : world;
 524         pcode IO IO_LSeek 2 3 1 =w2 =sz w h off 4;
 525         return w2, sz;
 526 ]
 527
 528 fn bsetsize(w : world, h : handle, size : int64) : world
 529 [
 530         var w2 : world;
 531         pcode IO IO_FTruncate 1 3 0 =w2 w h size;
 532         return w2;
 533 ]
 534
 535 fn bcontiguous(w : world, h : handle, pos : int64, size : int64) : world
 536 [
 537         var w2 : world;
 538         pcode IO IO_FAllocate 1 4 0 =w2 w h pos size;
 539         return w2;
 540 ]
 541
 542 fn bclone(w : world, src_h : handle, src_pos : int64, dst_h : handle, dst_pos : int64, size : int64) : world
 543 [
 544         var w2 : world;
 545         pcode IO IO_CloneRange 1 6 0 =w2 w src_h src_pos dst_h dst_pos size;
 546         return w2;
 547 ]
 548
 549 fn bopen_lazy(d : dhandle, f : bytes, flags : int) : handle
 550 [
 551         var h : handle;
 552         if flags <> IO_Open_Flag_Read then [
 553                 h := exception_make(handle, ec_sync, error_invalid_operation, 0, true);
 554                 return h;
 555         ]
 556         var w := unsafe_get_world;
 557         w, h := bopen(w, d, f, flags, 0);
 558         return h;
 559 ]
 560
 561 fn bread_lazy~lazy(h : handle, position : int64) : bytes
 562 [
 563         var b : bytes;
 564         var w := unsafe_get_world;
 565         w, b := bread(w, h, position, 16384);
 566         if len(b) < 16384 then
 567                 return b;
 568         return b + bread_lazy(h, position + 16384);
 569 ]
 570
 571 fn bsize_lazy(h : handle) : int64
 572 [
 573         var sz : int64;
 574         var w := unsafe_get_world;
 575         w, sz := bsize(w, h);
 576         return sz;
 577 ]
 578
 579 fn bdata_lazy(h : handle, off : int64) : int64
 580 [
 581         var sz : int64;
 582         var w := unsafe_get_world;
 583         w, sz := bdata(w, h, off);
 584         return sz;
 585 ]
 586
 587 fn bhole_lazy(h : handle, off : int64) : int64
 588 [
 589         var sz : int64;
 590         var w := unsafe_get_world;
 591         w, sz := bhole(w, h, off);
 592         return sz;
 593 ]
 594
 595 fn fdatasync(w : world, h : handle) : world
 596 [
 597         var w2 : world;
 598         pcode IO IO_FSync 1 2 1 =w2 w h 0;
 599         return w2;
 600 ]
 601
 602 fn fsync(w : world, h : handle) : world
 603 [
 604         var w2 : world;
 605         pcode IO IO_FSync 1 2 1 =w2 w h 1;
 606         return w2;
 607 ]
 608
 609 fn ffssync(w : world, h : handle) : world
 610 [
 611         var w2 : world;
 612         pcode IO IO_FSync 1 2 1 =w2 w h 2;
 613         return w2;
 614 ]
 615
 616 fn sync(w : world) : world
 617 [
 618         var w2 : world;
 619         pcode IO IO_Sync 1 1 0 =w2 w;
 620         return w2;
 621 ]
 622
 623 fn droot(w : world) : dhandle
 624 [
 625         var dh : dhandle;
 626         pcode IO IO_Root_Dir 1 1 1 =dh w 1;
 627         return dh;
 628 ]
 629
 630 fn dcwd(w : world) : dhandle
 631 [
 632         var dh : dhandle;
 633         pcode IO IO_Root_Dir 1 1 1 =dh w 2;
 634         return dh;
 635 ]
 636
 637 fn dlib(w : world) : dhandle
 638 [
 639         var dh : dhandle;
 640         pcode IO IO_Root_Dir 1 1 1 =dh w 3;
 641         return dh;
 642 ]
 643
 644 fn dexe(w : world) : dhandle
 645 [
 646         var dh : dhandle;
 647         pcode IO IO_Root_Dir 1 1 1 =dh w 4;
 648         return dh;
 649 ]
 650
 651 fn dnone(w : world) : dhandle
 652 [
 653         var dh : dhandle;
 654         pcode IO IO_Root_Dir 1 1 1 =dh w 5;
 655         return dh;
 656 ]
 657
 658 private fn libpath : bytes
 659 [
 660         var lp : bytes;
 661         pcode IO IO_Lib_Path 1 0 0 =lp;
 662         return lp;
 663 ]
 664
 665 fn dopen(w : world, d : dhandle, f : bytes, flags : int) : (world, dhandle)
 666 [
 667         var dh : dhandle;
 668         var w2 : world;
 669         pcode IO IO_Open_Dir 2 4 0 =w2 =dh w d f flags;
 670         return w2, dh;
 671 ]
 672
 673 fn dread(w : world, d : dhandle) : (world, list(bytes))
 674 [
 675         var res : list(bytes);
 676         var w2 : world;
 677         pcode IO IO_Read_Dir 2 2 0 =w2 =res w d;
 678         return w2, res;
 679 ]
 680
 681 fn dpath(w : world, d : dhandle) : (world, bytes)
 682 [
 683         var res : bytes;
 684         var w2 : world;
 685         pcode IO IO_Dir_Path 2 2 0 =w2 =res w d;
 686         return w2, res;
 687 ]
 688
 689 fn dopen_lazy(d : dhandle, f : bytes, flags : int) : dhandle
 690 [
 691         var res : dhandle;
 692         var w := unsafe_get_world;
 693         w, res := dopen(w, d, f, flags);
 694         return res;
 695 ]
 696
 697 fn dread_lazy(d : dhandle) : list(bytes)
 698 [
 699         var res : list(bytes);
 700         var w := unsafe_get_world;
 701         w, res := dread(w, d);
 702         return res;
 703 ]
 704
 705 fn dpath_lazy(d : dhandle) : bytes
 706 [
 707         var res : bytes;
 708         var w := unsafe_get_world;
 709         w, res := dpath(w, d);
 710         return res;
 711 ]
 712
 713 type mhandle := internal_type;
 714
 715 fn dmonitor_wait(w2 : world, h : mhandle) : world
 716 [
 717         var w3 : world;
 718         pcode IO IO_DMonitor_Wait 1 2 0 =w3 w2 h;
 719         return w3;
 720 ]
 721
 722 fn dmonitor(w : world, d : dhandle) : (world, world)
 723 [
 724         var h : mhandle;
 725         var w2 w3 : world;
 726         pcode IO IO_DMonitor_Prepare 2 2 0 =w2 =h w d;
 727         w3 := dmonitor_wait~spark(w2, h);
 728         return w2, w3;
 729 ]
 730
 731 const stat_flag_devmajor : int := IO_Stat_Flag_DevMajor;
 732 const stat_flag_devminor : int := IO_Stat_Flag_DevMinor;
 733 const stat_flag_inode : int := IO_Stat_Flag_Inode;
 734 const stat_flag_type : int := IO_Stat_Flag_Type;
 735 const stat_flag_mode : int := IO_Stat_Flag_Mode;
 736 const stat_flag_nlink : int := IO_Stat_Flag_NLink;
 737 const stat_flag_uid : int := IO_Stat_Flag_UID;
 738 const stat_flag_gid : int := IO_Stat_Flag_GID;
 739 const stat_flag_rdevmajor : int := IO_Stat_Flag_RDevMajor;
 740 const stat_flag_rdevminor : int := IO_Stat_Flag_RDevMinor;
 741 const stat_flag_size : int := IO_Stat_Flag_Size;
 742 const stat_flag_optimaliosize : int := IO_Stat_Flag_OptimalIOSize;
 743 const stat_flag_allocated : int := IO_Stat_Flag_Allocated;
 744 const stat_flag_atime : int := IO_Stat_Flag_ATime;
 745 const stat_flag_mtime : int := IO_Stat_Flag_MTime;
 746 const stat_flag_ctime : int := IO_Stat_Flag_CTime;
 747
 748 const stat_type_file : int := IO_Stat_Type_File;
 749 const stat_type_directory : int := IO_Stat_Type_Directory;
 750 const stat_type_link : int := IO_Stat_Type_Link;
 751 const stat_type_fifo : int := IO_Stat_Type_Pipe;
 752 const stat_type_chardev : int := IO_Stat_Type_CharDev;
 753 const stat_type_blockdev : int := IO_Stat_Type_BlockDev;
 754 const stat_type_socket : int := IO_Stat_Type_Socket;
 755
 756 fn stat(w : world, d : dhandle, f : bytes, flags : int) : (world, list(int64))
 757 [
 758         var res : list(int64);
 759         var w2 : world;
 760         pcode IO IO_Stat 2 4 1 =w2 =res w d f flags 1;
 761         return w2, res;
 762 ]
 763
 764 fn lstat(w : world, d : dhandle, f : bytes, flags : int) : (world, list(int64))
 765 [
 766         var res : list(int64);
 767         var w2 : world;
 768         pcode IO IO_Stat 2 4 1 =w2 =res w d f flags 2;
 769         return w2, res;
 770 ]
 771
 772 fn fstat(w : world, h : handle, flags : int) : (world, list(int64))
 773 [
 774         var res : list(int64);
 775         var w2 : world;
 776         pcode IO IO_FStat 2 3 0 =w2 =res w h flags;
 777         return w2, res;
 778 ]
 779
 780 fn stat_lazy(d : dhandle, f : bytes, flags : int) : list(int64)
 781 [
 782         var res : list(int64);
 783         var w := unsafe_get_world;
 784         w, res := stat(w, d, f, flags);
 785         return res;
 786 ]
 787
 788 fn lstat_lazy(d : dhandle, f : bytes, flags : int) : list(int64)
 789 [
 790         var res : list(int64);
 791         var w := unsafe_get_world;
 792         w, res := lstat(w, d, f, flags);
 793         return res;
 794 ]
 795
 796 fn fstat_lazy(h : handle, flags : int) : list(int64)
 797 [
 798         var res : list(int64);
 799         var w := unsafe_get_world;
 800         w, res := fstat(w, h, flags);
 801         return res;
 802 ]
 803
 804 const statfs_flag_bsize : int := IO_StatFS_Flag_BSize;
 805 const statfs_flag_frsize : int := IO_StatFS_Flag_FrSize;
 806 const statfs_flag_frtotal : int := IO_StatFS_Flag_FrTotal;
 807 const statfs_flag_frfree : int := IO_StatFS_Flag_FrFree;
 808 const statfs_flag_fravail : int := IO_StatFS_Flag_FrAvail;
 809 const statfs_flag_intotal : int := IO_StatFS_Flag_InTotal;
 810 const statfs_flag_infree : int := IO_StatFS_Flag_InFree;
 811 const statfs_flag_inavail : int := IO_StatFS_Flag_InAvail;
 812 const statfs_flag_fsid : int := IO_StatFS_Flag_FSId;
 813 const statfs_flag_flags : int := IO_StatFS_Flag_Flags;
 814 const statfs_flag_namelen : int := IO_StatFS_Flag_NameLen;
 815
 816 const statfs_st_readonly : int := IO_StatFS_ST_ReadOnly;
 817 const statfs_st_nosuid : int := IO_StatFS_ST_NoSuid;
 818 const statfs_st_nodev : int := IO_StatFS_ST_NoDev;
 819 const statfs_st_noexec : int := IO_StatFS_ST_NoExec;
 820 const statfs_st_synchronous : int := IO_StatFS_ST_Synchronous;
 821 const statfs_st_mandlock : int := IO_StatFS_ST_MandLock;
 822 const statfs_st_noatime : int := IO_StatFS_ST_NoAtime;
 823 const statfs_st_nodiratime : int := IO_StatFS_ST_NoDirAtime;
 824 const statfs_st_relatime : int := IO_StatFS_ST_RelAtime;
 825
 826 fn fstatfs(w : world, h : handle, flags : int) : (world, list(int64))
 827 [
 828         var res : list(int64);
 829         var w2 : world;
 830         pcode IO IO_FStatFS 2 3 0 =w2 =res w h flags;
 831         return w2, res;
 832 ]
 833
 834 fn dstatfs(w : world, d : dhandle, flags : int) : (world, list(int64))
 835 [
 836         var res : list(int64);
 837         var w2 : world;
 838         pcode IO IO_DStatFS 2 3 0 =w2 =res w d flags;
 839         return w2, res;
 840 ]
 841
 842 fn readlink(w : world, d : dhandle, f : bytes) : (world, bytes)
 843 [
 844         var res : bytes;
 845         var w2 : world;
 846         pcode IO IO_ReadLink 2 3 0 =w2 =res w d f;
 847         return w2, res;
 848 ]
 849
 850 fn readlink_lazy(d : dhandle, f : bytes) : bytes
 851 [
 852         var res : bytes;
 853         var w := unsafe_get_world;
 854         w, res := readlink(w, d, f);
 855         return res;
 856 ]
 857
 858 fn unlink(w : world, d : dhandle, f : bytes) : world
 859 [
 860         var w2 : world;
 861         pcode IO IO_Dir_Action 1 3 1 =w2 w d f IO_Action_Rm;
 862         return w2;
 863 ]
 864
 865 fn rmdir(w : world, d : dhandle, f : bytes) : world
 866 [
 867         var w2 : world;
 868         pcode IO IO_Dir_Action 1 3 1 =w2 w d f IO_Action_Rm_Dir;
 869         return w2;
 870 ]
 871
 872 fn mkdir(w : world, d : dhandle, f : bytes, mode : int) : world
 873 [
 874         var w2 : world;
 875         pcode IO IO_Dir_Action 1 4 1 =w2 w d f mode IO_Action_Mk_Dir;
 876         return w2;
 877 ]
 878
 879 fn mkpipe(w : world, d : dhandle, f : bytes, mode : int) : world
 880 [
 881         var w2 : world;
 882         pcode IO IO_Dir_Action 1 4 1 =w2 w d f mode IO_Action_Mk_Pipe;
 883         return w2;
 884 ]
 885
 886 fn mksocket(w : world, d : dhandle, f : bytes, mode : int) : world
 887 [
 888         var w2 : world;
 889         pcode IO IO_Dir_Action 1 4 1 =w2 w d f mode IO_Action_Mk_Socket;
 890         return w2;
 891 ]
 892
 893 fn mkchardev(w : world, d : dhandle, f : bytes, mode major minor : int) : world
 894 [
 895         var w2 : world;
 896         pcode IO IO_Dir_Action 1 6 1 =w2 w d f mode major minor IO_Action_Mk_CharDev;
 897         return w2;
 898 ]
 899
 900 fn mkblockdev(w : world, d : dhandle, f : bytes, mode major minor : int) : world
 901 [
 902         var w2 : world;
 903         pcode IO IO_Dir_Action 1 6 1 =w2 w d f mode major minor IO_Action_Mk_BlockDev;
 904         return w2;
 905 ]
 906
 907 fn mksymlink(w : world, d : dhandle, f t : bytes) : world
 908 [
 909         var w2 : world;
 910         pcode IO IO_Dir_Action 1 4 1 =w2 w d f t IO_Action_Mk_SymLink;
 911         return w2;
 912 ]
 913
 914 fn mklink(w : world, d : dhandle, f : bytes, e : dhandle, t : bytes) : world
 915 [
 916         var w2 : world;
 917         pcode IO IO_Dir2_Action 1 5 1 =w2 w d f e t IO_Action_Mk_Link;
 918         return w2;
 919 ]
 920
 921 fn rename(w : world, d : dhandle, f : bytes, e : dhandle, t : bytes) : world
 922 [
 923         var w2 : world;
 924         pcode IO IO_Dir2_Action 1 5 1 =w2 w d f e t IO_Action_Rename;
 925         return w2;
 926 ]
 927
 928 fn chmod(w : world, d : dhandle, f : bytes, m : int) : world
 929 [
 930         var w2 : world;
 931         pcode IO IO_Dir_Action 1 4 1 =w2 w d f m IO_Action_ChMod;
 932         return w2;
 933 ]
 934
 935 fn chown(w : world, d : dhandle, f : bytes, uid gid : int) : world
 936 [
 937         var w2 : world;
 938         pcode IO IO_Dir_Action 1 5 1 =w2 w d f uid gid IO_Action_ChOwn;
 939         return w2;
 940 ]
 941
 942 fn lchown(w : world, d : dhandle, f : bytes, uid gid : int) : world
 943 [
 944         var w2 : world;
 945         pcode IO IO_Dir_Action 1 5 1 =w2 w d f uid gid IO_Action_LChOwn;
 946         return w2;
 947 ]
 948
 949 fn utime(w : world, d : dhandle, f : bytes, atime mtime : int64) : world
 950 [
 951         var w2 : world;
 952         pcode IO IO_Dir_Action 1 5 1 =w2 w d f mtime atime IO_Action_UTime;
 953         return w2;
 954 ]
 955
 956 fn lutime(w : world, d : dhandle, f : bytes, atime mtime : int64) : world
 957 [
 958         var w2 : world;
 959         pcode IO IO_Dir_Action 1 5 1 =w2 w d f mtime atime IO_Action_LUTime;
 960         return w2;
 961 ]
 962
 963
 964 const stty_flag_raw : int := IO_Stty_Flag_Raw;
 965 const stty_flag_noecho : int := IO_Stty_Flag_Noecho;
 966 const stty_flag_nosignal : int := IO_Stty_Flag_Nosignal;
 967 const stty_flag_nocrlf : int := IO_Stty_Flag_NoCRLF;
 968
 969 fn stty(w : world, h : handle, flags : int) : world
 970 [
 971         var w2 : world;
 972         pcode IO IO_Stty 1 3 0 =w2 w h flags;
 973         return w2;
 974 ]
 975
 976 fn tty_size(w : world, h : handle, x y : int) : (world, int, int)
 977 [
 978         var nx ny : int;
 979         var w2 : world;
 980         pcode IO IO_Tty_Size 3 4 0 =w2 =nx =ny w h x y;
 981         return w2, nx, ny;
 982 ]
 983
 984 const uname_flag_ajla_version : int := IO_UName_Flag_Ajla_Version;
 985 const uname_flag_flavor : int := IO_UName_Flag_Flavor;
 986 const uname_flag_system : int := IO_UName_Flag_System;
 987 const uname_flag_release : int := IO_UName_Flag_Release;
 988 const uname_flag_version : int := IO_UName_Flag_Version;
 989 const uname_flag_machine : int := IO_UName_Flag_Machine;
 990
 991 fn uname(flags : int) : list(bytes)
 992 [
 993         var res : list(bytes);
 994         pcode IO IO_UName 1 1 0 =res flags;
 995         return res;
 996 ]
 997
 998 fn get_host_name(w : world) : (world, bytes)
 999 [
1000         var res : bytes;
1001         var w2 : world;
1002         pcode IO IO_GetHostName 2 1 0 =w2 =res w;
1003         return w2, res;
1004 ]
1005
1006
1007 fn get_real_time(w : world) : (world, int64)
1008 [
1009         var ret : int64;
1010         var w2 : world;
1011         pcode IO IO_GetTime 2 1 1 =w2 =ret w 1;
1012         return w2, ret;
1013 ]
1014
1015 fn get_monotonic_time(w : world) : (world, int64)
1016 [
1017         var ret : int64;
1018         var w2 : world;
1019         pcode IO IO_GetTime 2 1 1 =w2 =ret w 2;
1020         return w2, ret;
1021 ]
1022
1023 fn sleep(t : type, w : t, tm : int64) : t
1024 [
1025         xeval w;
1026         var w2 : t;
1027         var u : int64;
1028         var w3 : world;
1029         w3, u := get_monotonic_time(unsafe_get_world);
1030         u += tm;
1031         pcode IO IO_Sleep 1 2 0 =w2 w u;
1032         return w2;
1033 ]
1034
1035 {--------
1036  - PATH -
1037  --------}
1038
1039 const path_separator : byte
1040 [
1041         var os := sysprop(SystemProperty_OS);
1042         if os = SystemProperty_OS_DOS or
1043            os = SystemProperty_OS_OS2 or
1044            os = SystemProperty_OS_Windows then
1045                 return '\';
1046         return '/';
1047 ]
1048
1049 fn path_is_separator(b : byte) : bool
1050 [
1051         if b = '\' or b = ':' then [
1052                 var os := sysprop(SystemProperty_OS);
1053                 if os = SystemProperty_OS_DOS or
1054                    os = SystemProperty_OS_OS2 or
1055                    os = SystemProperty_OS_Cygwin or
1056                    os = SystemProperty_OS_Windows then
1057                         return true;
1058         ]
1059         return b = '/';
1060 ]
1061
1062 fn path_is_dir_separator(b : byte) : bool
1063 [
1064         if b = '\' then [
1065                 var os := sysprop(SystemProperty_OS);
1066                 if os = SystemProperty_OS_DOS or
1067                    os = SystemProperty_OS_OS2 or
1068                    os = SystemProperty_OS_Cygwin or
1069                    os = SystemProperty_OS_Windows then
1070                         return true;
1071         ]
1072         return b = '/';
1073 ]
1074
1075 fn path_compare(a b : bytes) : bool
1076 [
1077         var os := sysprop(SystemProperty_OS);
1078         if os = SystemProperty_OS_DOS or
1079            os = SystemProperty_OS_OS2 or
1080            os = SystemProperty_OS_Windows then [
1081                 if len(a) <> len(b) then
1082                         return false;
1083                 for i := 0 to len(a) do [
1084                         var a1 := a[i];
1085                         var b1 := b[i];
1086                         if a1 >= 'a', a1 <= 'z' then
1087                                 a1 -= #20;
1088                         if b1 >= 'a', b1 <= 'z' then
1089                                 b1 -= #20;
1090                         if a1 <> b1 then
1091                                 return false;
1092                 ]
1093                 return true;
1094         ]
1095         return a = b;
1096 ]
1097
1098 fn dos_path_is_absolute(p : bytes) : bool
1099 [
1100         if len_at_least(p, 3), (p[0] and #DF) >= 'A', (p[0] and #DF) <= 'Z', p[1] = ':', path_is_dir_separator(p[2]) then
1101                 return true;
1102         if len_at_least(p, 2), path_is_dir_separator(p[0]), path_is_dir_separator(p[1]) then
1103                 return true;
1104         return false;
1105 ]
1106
1107 fn path_is_absolute(p : bytes) : bool
1108 [
1109         var os := sysprop(SystemProperty_OS);
1110         if os = SystemProperty_OS_DOS or
1111            os = SystemProperty_OS_OS2 or
1112            os = SystemProperty_OS_Windows then [
1113                 return dos_path_is_absolute(p);
1114         ]
1115         if len_at_least(p, 1), path_is_dir_separator(p[0]) then
1116                 return true;
1117         if os = SystemProperty_OS_Cygwin then
1118                 return dos_path_is_absolute(p);
1119         return false;
1120 ]
1121
1122 fn path_is_root(p : bytes) : bool
1123 [
1124         p := path_contract(p);
1125         if len(p) = 1, path_is_dir_separator(p[0]) then
1126                 return true;
1127         var os := sysprop(SystemProperty_OS);
1128         if os = SystemProperty_OS_DOS or
1129            os = SystemProperty_OS_OS2 or
1130            os = SystemProperty_OS_Cygwin or
1131            os = SystemProperty_OS_Windows then [
1132                 if len(p) = 3, (p[0] and #DF) >= 'A', (p[0] and #DF) <= 'Z', p[1] = ':', path_is_dir_separator(p[2]) then
1133                         return true;
1134         ]
1135         return false;
1136 ]
1137
1138 fn path_to_dir_file(p : bytes) : (bytes, bytes)
1139 [
1140         var idx := list_search_backwards_fn(p, path_is_separator);
1141         var dir := p[ .. idx + 1];
1142         var file := p[idx + 1 .. ];
1143         if file = "." or file = ".." then [
1144                 dir := p +< path_separator;
1145                 file := "";
1146         ]
1147         if dir = "" then
1148                 dir := "." + bytes.[ path_separator ];
1149         if len(dir) > 1 then
1150                 dir := dir[ .. len(dir) - 1];
1151         return dir, file;
1152 ]
1153
1154 fn path_append(pd pf : bytes) : bytes
1155 [
1156         if len(pd) > 0, not path_is_separator(pd[len(pd) - 1]) then
1157                 pd += bytes.[ path_separator ];
1158         return pd + pf;
1159 ]
1160
1161 fn path_contract_unix(p : bytes, trim_dot : bool) : bytes
1162 [
1163         for i := 0 to len(p) do [
1164                 if path_is_dir_separator(p[i]) then
1165                         p[i] := '/';
1166         ]
1167         var leading_slash := false;
1168         if len_at_least(p, 1), p[0] = '/' then [
1169                 p := p[1 .. ];
1170                 leading_slash := true;
1171         ]
1172         var components := list_break(p, '/');
1173         var result := empty(bytes);
1174         for i := 0 to len(components) do [
1175                 if components[i] = "" then
1176                         continue;
1177                 if components[i] = ".", trim_dot then
1178                         continue;
1179                 if components[i] = ".." then [
1180                         if len(result) >= 1 then [
1181                                 if result[len(result) - 1] = ".." then
1182                                         goto add_to_result;
1183                                 result := result[ .. len(result) - 1];
1184                                 continue;
1185                         ] else [
1186                                 if leading_slash then
1187                                         continue;
1188                         ]
1189                 ]
1190 add_to_result:
1191                 result +<= components[i];
1192         ]
1193         var r := "";
1194         if leading_slash then
1195                 r +<= path_separator;
1196         for i := 0 to len(result) do [
1197                 if i > 0 then
1198                         r +<= path_separator;
1199                 r += result[i];
1200         ]
1201         if r = "" then
1202                 r := ".";
1203         return r;
1204 ]
1205
1206 fn path_contract(p : bytes) : bytes
1207 [
1208         if path_is_separator(':') then [
1209                 if len_at_least(p, 2), (p[0] and #DF) >= 'A', (p[0] and #DF) <= 'Z', p[1] = ':' then
1210                         return p[ .. 2] + path_contract_unix(p[2 .. ], true);
1211                 if len_at_least(p, 2), path_is_dir_separator(p[0]), path_is_dir_separator(p[1]) then
1212                         return [ path_separator ] + path_contract_unix(p[1 .. ], false);
1213         ]
1214         return path_contract_unix(p, true);
1215 ]
1216
1217 fn path_join(pd pf : bytes) : bytes
1218 [
1219         if path_is_absolute(pf) then
1220                 return path_contract(pf);
1221         if path_is_separator(':') then [
1222                 if len_at_least(pf, 1), path_is_separator(pf[0]) then [
1223                         if len_at_least(pd, 2), (pd[0] and #DF) >= 'A', (pd[0] and #DF) <= 'Z', pd[1] = ':' then [
1224                                 return path_contract(pd[ .. 2] + pf);
1225                         ]
1226                         if len_at_least(pd, 2), path_is_dir_separator(pd[0]), path_is_dir_separator(pd[1]) then [
1227                                 return path_contract(pd[ .. 1] + pf);
1228                         ]
1229                         return path_contract(pf);
1230                 ]
1231                 if len_at_least(pf, 2), (pf[0] and #DF) >= 'A', (pf[0] and #DF) <= 'Z', pf[1] = ':' then [
1232                         if len_at_least(pd, 3), (pd[0] and #DF) = (pf[0] and #DF), pd[1] = ':', path_is_dir_separator(pd[2]) then [
1233                                 pf := pf[2 .. ];
1234                         ] else [
1235                                 return path_contract(pf[ .. 2] + [ path_separator ] + pf[2 .. ]);
1236                         ]
1237                 ]
1238         ]
1239         return path_contract(path_append(pd, pf));
1240 ]
1241
1242 fn path_canonical(implicit w : world, d : dhandle, p : bytes) : (world, bytes)
1243 [
1244         var dir, file := path_to_dir_file(p);
1245         var pd := dopen(d, dir, 0);
1246         var pdp := dpath(pd);
1247         var pj := path_append(pdp, file);
1248         return pj;
1249 ]
1250
1251 fn path_get_cwd(implicit w : world, d : dhandle, env : treemap(bytes, bytes)) : (world, bytes)
1252 [
1253         var p1 := dpath(d);
1254         var t := treemap_search(env, "PWD");
1255         if t is j, path_is_absolute(t.j) then [
1256                 var ctr := path_contract(t.j);
1257                 var old_w := w;
1258                 var pd2 := dopen(dnone(), ctr, 0);
1259                 if is_exception pd2 then [
1260                         recover_world(old_w);
1261                         return p1;
1262                 ]
1263                 old_w := w;
1264                 var p2 := dpath(pd2);
1265                 if is_exception p2 then [
1266                         recover_world(old_w);
1267                         return p1;
1268                 ]
1269                 if p1 = p2 then
1270                         return ctr;
1271         ]
1272         return p1;
1273 ]
1274
1275 fn path_shortcut_home(home : maybe(bytes), p : bytes) : bytes
1276 [
1277         if home is n then
1278                 return p;
1279         if not path_is_absolute(home.j) then
1280                 return p;
1281         var h := path_contract(home.j);
1282         if h = p then
1283                 return "~";
1284         if len(h) < len(p), path_compare(h, p[ .. len(h)]), path_is_dir_separator(p[len(h)]) then
1285                 return "~" + p[len(h) .. ];
1286         return p;
1287 ]
1288
1289 fn path_expand_home(home : maybe(bytes), p : bytes) : bytes
1290 [
1291         if home is n then
1292                 return p;
1293         var h := home.j;
1294         if not path_is_absolute(h) then
1295                 return p;
1296         h := path_contract(h);
1297         if p = "~" then
1298                 return h;
1299         if len(p) >= 2, p[0] = '~', path_is_dir_separator(p[1]) then [
1300                 var i := 2;
1301                 while len(p) > i, path_is_dir_separator(p[i]) do
1302                         i += 1;
1303                 return path_append(h, p[i .. ]);
1304         ]
1305         return p;
1306 ]
1307
1308 fn path_mkdir_step(implicit w : world, d : dhandle, f : bytes, mode : int) : world
1309 [
1310         var w1 := w;
1311         mkdir(d, f, mode);
1312         if is_exception w then [
1313                 if exception_type w = error_system, exception_aux w = system_error_eexist then [
1314                         recover_world(w1);
1315                 ]
1316         ]
1317 ]
1318
1319 fn path_mkdir(implicit w : world, d : dhandle, f : bytes, mode : int) : world
1320 [
1321         var w1 := w;
1322         path_mkdir_step(d, f, mode);
1323         if not is_exception w then
1324                 return w;
1325         recover_world(w1);
1326
1327         var i := 0;
1328         while i < len(f), path_is_separator(f[i]) do
1329                 i += 1;
1330         if i = 0, path_is_absolute(f) then [
1331                 while i < len(f), not path_is_separator(f[i]) do
1332                         i += 1;
1333                 while i < len(f), path_is_separator(f[i]) do
1334                         i += 1;
1335         ]
1336
1337         while i < len(f) do [
1338                 while i < len(f), not path_is_separator(f[i]) do
1339                         i += 1;
1340                 while i < len(f), path_is_separator(f[i]) do
1341                         i += 1;
1342                 path_mkdir_step(d, f[ .. i], mode);
1343                 xeval w;
1344         ]
1345 ]
1346
1347 fn path_xdg(implicit w : world, env : treemap(bytes, bytes), xdg_env : bytes, deflt : bytes, appname : bytes) : (world, dhandle)
1348 [
1349         var w1 := w;
1350 again:
1351         var d : bytes;
1352         var x := treemap_search(env, xdg_env);
1353         if x is j then [
1354                 if path_is_absolute(x.j) then [
1355                         d := x.j;
1356                         goto have_d;
1357                 ]
1358         ]
1359         if sysprop(SystemProperty_OS) = SystemProperty_OS_Windows then [
1360                 x := treemap_search(env, "APPDATA");
1361                 if x is j then
1362                         goto have_x;
1363         ]
1364         x := treemap_search(env, "HOME");
1365         if x is j then [
1366 have_x:
1367                 var a := path_append(x.j, deflt);
1368                 if path_is_absolute(a) then [
1369                         d := a;
1370                         goto have_d;
1371                 ]
1372         ]
1373         d := dpath(dexe());
1374 have_d:
1375         d := path_append(d, appname);
1376         path_mkdir(dnone(), d, #1c0);
1377         if is_exception w then [
1378                 if len(deflt) > 0, deflt[0] = '.' then [
1379                         recover_world(w1);
1380                         deflt := deflt[1 .. ];
1381                         goto again;
1382                 ]
1383         ]
1384         return dopen(dnone(), d, 0);
1385 ]
1386
1387 fn path_config(implicit w : world, env : treemap(bytes, bytes), appname : bytes) : (world, dhandle)
1388 [
1389         return path_xdg(env, "XDG_CONFIG_HOME", ".config", appname);
1390 ]
1391
1392 fn path_write_atomic(implicit w : world, d : dhandle, f : bytes, content : bytes) : world
1393 [
1394         var w1 := w;
1395         var tmp_file := f;
1396         var i := len(tmp_file) - 1;
1397         while i >= 0 do [
1398                 if path_is_separator(tmp_file[i]) then
1399                         break;
1400                 if tmp_file[i] = '.' then [
1401                         tmp_file := tmp_file[ .. i];
1402                         break;
1403                 ]
1404                 i -= 1;
1405         ]
1406         tmp_file +<= '.';
1407         var num := 0;
1408         atomic_enter();
1409 next_num:
1410         var tmp_file_x := tmp_file + ntos(num);
1411         var wf := wopen(d, tmp_file_x, open_flag_create or open_flag_must_create, #180);
1412         if is_exception w, exception_aux w = system_error_eexist, not is_exception w1 then [
1413                 recover_world(w1);
1414                 num += 1;
1415                 goto next_num;
1416         ]
1417         write(wf, content);
1418         rename(d, f, d, tmp_file_x);
1419         if is_exception w then [
1420                 var xw := w;
1421                 recover_world(w1);
1422                 unlink(d, tmp_file);
1423                 atomic_exit();
1424                 keep w;
1425                 return xw;
1426         ]
1427         atomic_exit();
1428 ]
1429
1430 {----------------
1431  - DEPENDENCIES -
1432  ----------------}
1433
1434 fn register_dependence(implicit w : world, d : dhandle, p : bytes) : world
1435 [
1436         var cp := path_canonical(d, p);
1437         var w2 : world;
1438         pcode IO IO_Register_Dependence 1 2 0 =w2 w cp;
1439         return w2;
1440 ]