newlib/io.ajla

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