1(* 2 Title: Standard Basis Library: Posix structure and signature. 3 Copyright David Matthews 2000, 2016-17, 2019-2020 4 5 This library is free software; you can redistribute it and/or 6 modify it under the terms of the GNU Lesser General Public 7 License version 2.1 as published by the Free Software Foundation. 8 9 This library is distributed in the hope that it will be useful, 10 but WITHOUT ANY WARRANTY; without even the implied warranty of 11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 12 Lesser General Public License for more details. 13 14 You should have received a copy of the GNU Lesser General Public 15 License along with this library; if not, write to the Free Software 16 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 17*) 18 19signature POSIX_ERROR = 20sig 21 type syserror = OS.syserror (* G&R 2004 has an error *) 22 23 val toWord : syserror -> SysWord.word 24 val fromWord : SysWord.word -> syserror 25 val errorMsg : syserror -> string 26 val errorName : syserror -> string 27 val syserror : string -> syserror option 28 29 val acces : syserror 30 val again : syserror 31 val badf : syserror 32 val badmsg : syserror 33 val busy : syserror 34 val canceled (* sic *) : syserror 35 val child : syserror 36 val deadlk : syserror 37 val dom : syserror 38 val exist : syserror 39 val fault : syserror 40 val fbig : syserror 41 val inprogress : syserror 42 val intr : syserror 43 val inval : syserror 44 val io : syserror 45 val isdir : syserror 46 val loop : syserror 47 val mfile : syserror 48 val mlink : syserror 49 val msgsize : syserror 50 val nametoolong : syserror 51 val nfile : syserror 52 val nodev : syserror 53 val noent : syserror 54 val noexec : syserror 55 val nolck : syserror 56 val nomem : syserror 57 val nospc : syserror 58 val nosys : syserror 59 val notdir : syserror 60 val notempty : syserror 61 val notsup : syserror 62 val notty : syserror 63 val nxio : syserror 64 val perm : syserror 65 val pipe : syserror 66 val range : syserror 67 val rofs : syserror 68 val spipe : syserror 69 val srch : syserror 70 val toobig : syserror 71 val xdev : syserror 72end; 73 74signature POSIX_SIGNAL = 75sig 76 eqtype signal 77 val toWord : signal -> SysWord.word 78 val fromWord : SysWord.word -> signal 79 val abrt : signal 80 val alrm : signal 81 val bus : signal 82 val fpe : signal 83 val hup : signal 84 val ill : signal 85 val int : signal 86 val kill : signal 87 val pipe : signal 88 val quit : signal 89 val segv : signal 90 val term : signal 91 val usr1 : signal 92 val usr2 : signal 93 val chld : signal 94 val cont : signal 95 val stop : signal 96 val tstp : signal 97 val ttin : signal 98 val ttou : signal 99end; 100 101signature POSIX_PROCESS = 102sig 103 eqtype signal 104 eqtype pid 105 val wordToPid : SysWord.word -> pid 106 val pidToWord : pid -> SysWord.word 107 108 val fork : unit -> pid option 109 val exec : string * string list -> 'a 110 val exece : string * string list * string list -> 'a 111 val execp : string * string list -> 'a 112 113 datatype waitpid_arg = 114 W_ANY_CHILD | W_CHILD of pid | W_SAME_GROUP | W_GROUP of pid 115 datatype exit_status = 116 W_EXITED | W_EXITSTATUS of Word8.word 117 | W_SIGNALED (* sic *) of signal | W_STOPPED of signal 118 119 val fromStatus : OS.Process.status -> exit_status 120 121 structure W: 122 sig 123 include BIT_FLAGS 124 val untraced : flags 125 end 126 127 val wait : unit -> pid * exit_status 128 val waitpid : waitpid_arg * W.flags list -> pid * exit_status 129 val waitpid_nh : waitpid_arg * W.flags list -> (pid * exit_status) option 130 131 val exit : Word8.word -> 'a 132 133 datatype killpid_arg = K_PROC of pid | K_SAME_GROUP | K_GROUP of pid 134 135 val kill : killpid_arg * signal -> unit 136 val alarm : Time.time -> Time.time 137 val pause : unit -> unit 138 val sleep : Time.time -> Time.time 139end; 140 141signature POSIX_PROC_ENV = 142sig 143 eqtype pid 144 eqtype uid 145 eqtype gid 146 eqtype file_desc 147 val uidToWord : uid -> SysWord.word 148 val wordToUid : SysWord.word -> uid 149 val gidToWord : gid -> SysWord.word 150 val wordToGid : SysWord.word -> gid 151 val getpid : unit -> pid 152 val getppid : unit -> pid 153 val getuid : unit -> uid 154 val geteuid : unit -> uid 155 val getgid : unit -> gid 156 val getegid : unit -> gid 157 val setuid : uid -> unit 158 val setgid : gid -> unit 159 val getgroups : unit -> gid list 160 val getlogin : unit -> string 161 val getpgrp : unit -> pid 162 val setsid : unit -> pid 163 val setpgid : {pid : pid option, pgid : pid option} -> unit 164 val uname : unit -> (string * string) list 165 val time : unit -> Time.time 166 val times : unit 167 -> { 168 elapsed : Time.time, 169 utime : Time.time, 170 stime : Time.time, 171 cutime : Time.time, 172 cstime : Time.time 173 } 174 175 val getenv : string -> string option 176 val environ : unit -> string list 177 val ctermid : unit -> string 178 val ttyname : file_desc -> string 179 val isatty : file_desc -> bool 180 val sysconf : string -> SysWord.word 181end; 182 183signature POSIX_FILE_SYS = 184sig 185 eqtype uid 186 eqtype gid 187 eqtype file_desc 188 val fdToWord : file_desc -> SysWord.word 189 val wordToFD : SysWord.word -> file_desc 190 val fdToIOD : file_desc -> OS.IO.iodesc 191 val iodToFD : OS.IO.iodesc -> file_desc option 192 type dirstream 193 val opendir : string -> dirstream 194 val readdir : dirstream -> string option 195 val rewinddir : dirstream -> unit 196 val closedir : dirstream -> unit 197 val chdir : string -> unit 198 val getcwd : unit -> string 199 200 val stdin : file_desc 201 val stdout : file_desc 202 val stderr : file_desc 203 204 structure S : 205 sig 206 eqtype mode 207 include BIT_FLAGS 208 where type flags = mode 209 val irwxu : mode 210 val irusr : mode 211 val iwusr : mode 212 val ixusr : mode 213 val irwxg : mode 214 val irgrp : mode 215 val iwgrp : mode 216 val ixgrp : mode 217 val irwxo : mode 218 val iroth : mode 219 val iwoth : mode 220 val ixoth : mode 221 val isuid : mode 222 val isgid : mode 223 end 224 225 structure O: 226 sig 227 include BIT_FLAGS 228 val append : flags 229 val excl : flags 230 val noctty : flags 231 val nonblock : flags 232 val sync : flags 233 val trunc : flags 234 end 235 236 datatype open_mode = O_RDONLY | O_WRONLY | O_RDWR 237 val openf : string * open_mode * O.flags -> file_desc 238 val createf : string * open_mode * O.flags * S.mode -> file_desc 239 val creat : string * S.mode -> file_desc 240 val umask : S.mode -> S.mode 241 val link : {old : string, new : string} -> unit 242 val mkdir : string * S.mode -> unit 243 val mkfifo : string * S.mode -> unit 244 val unlink : string -> unit 245 val rmdir : string -> unit 246 val rename : {old : string, new : string} -> unit 247 val symlink : {old : string, new : string} -> unit 248 val readlink : string -> string 249 250 eqtype dev 251 val wordToDev : SysWord.word -> dev 252 val devToWord : dev -> SysWord.word 253 254 eqtype ino 255 val wordToIno : SysWord.word -> ino 256 val inoToWord : ino -> SysWord.word 257 258 structure ST: 259 sig 260 type stat 261 val isDir : stat -> bool 262 val isChr : stat -> bool 263 val isBlk : stat -> bool 264 val isReg : stat -> bool 265 val isFIFO : stat -> bool 266 val isLink : stat -> bool 267 val isSock : stat -> bool 268 val mode : stat -> S.mode 269 val ino : stat -> ino 270 val dev : stat -> dev 271 val nlink : stat -> int 272 val uid : stat -> uid 273 val gid : stat -> gid 274 val size : stat -> Position.int 275 val atime : stat -> Time.time 276 val mtime : stat -> Time.time 277 val ctime : stat -> Time.time 278 end 279 280 val stat : string -> ST.stat 281 val lstat : string -> ST.stat 282 val fstat : file_desc -> ST.stat 283 284 datatype access_mode = A_READ | A_WRITE | A_EXEC 285 286 val access : string * access_mode list -> bool 287 val chmod : string * S.mode -> unit 288 val fchmod : file_desc * S.mode -> unit 289 val chown : string * uid * gid -> unit 290 val fchown : file_desc * uid * gid -> unit 291 val utime : string * {actime : Time.time, modtime : Time.time} option -> unit 292 val ftruncate : file_desc * Position.int -> unit 293 val pathconf : string * string -> SysWord.word option 294 val fpathconf : file_desc * string -> SysWord.word option 295end; 296 297signature POSIX_IO = 298sig 299 eqtype file_desc 300 eqtype pid 301 val pipe: unit -> {infd : file_desc, outfd : file_desc} 302 val dup: file_desc -> file_desc 303 val dup2: {old : file_desc, new : file_desc} -> unit 304 val close: file_desc -> unit 305 val readVec : file_desc * int -> Word8Vector.vector 306 val readArr: file_desc * Word8ArraySlice.slice -> int 307 val writeVec: file_desc * Word8VectorSlice.slice -> int 308 val writeArr: file_desc * Word8ArraySlice.slice -> int 309 310 datatype whence = SEEK_SET | SEEK_CUR | SEEK_END 311 312 structure FD: 313 sig 314 include BIT_FLAGS 315 val cloexec: flags 316 end 317 318 structure O: 319 sig 320 include BIT_FLAGS 321 val append : flags 322 val nonblock : flags 323 val sync : flags 324 end 325 326 datatype open_mode = O_RDONLY | O_WRONLY | O_RDWR 327 328 val dupfd : {old : file_desc, base : file_desc} -> file_desc 329 val getfd : file_desc -> FD.flags 330 val setfd : file_desc * FD.flags -> unit 331 val getfl : file_desc -> O.flags * open_mode 332 val setfl : file_desc * O.flags -> unit 333 val lseek : file_desc * Position.int * whence -> Position.int 334 val fsync : file_desc -> unit 335 336 datatype lock_type = F_RDLCK | F_WRLCK | F_UNLCK 337 338 structure FLock: 339 sig 340 type flock 341 val flock : { 342 ltype : lock_type, 343 whence : whence, 344 start : Position.int, 345 len : Position.int, 346 pid : pid option 347 } -> flock 348 val ltype : flock -> lock_type 349 val whence : flock -> whence 350 val start : flock -> Position.int 351 val len : flock -> Position.int 352 val pid : flock -> pid option 353 end 354 355 val getlk : file_desc * FLock.flock -> FLock.flock 356 val setlk : file_desc * FLock.flock -> FLock.flock 357 val setlkw : file_desc * FLock.flock -> FLock.flock 358 359 val mkBinReader: 360 { fd : file_desc, name : string, initBlkMode : bool } -> BinPrimIO.reader 361 val mkTextReader: 362 { fd : file_desc, name : string, initBlkMode : bool } -> TextPrimIO.reader 363 364 val mkBinWriter: 365 { fd : file_desc, name : string, appendMode : bool, 366 initBlkMode : bool, chunkSize : int } -> BinPrimIO.writer 367 val mkTextWriter: 368 { fd : file_desc, name : string, appendMode : bool, 369 initBlkMode : bool, chunkSize : int } -> TextPrimIO.writer 370 371end; 372 373signature POSIX_SYS_DB = 374sig 375 eqtype uid 376 eqtype gid 377 structure Passwd : 378 sig 379 type passwd 380 val name : passwd -> string 381 val uid : passwd -> uid 382 val gid : passwd -> gid 383 val home : passwd -> string 384 val shell : passwd -> string 385 end 386 structure Group : 387 sig 388 type group 389 val name : group -> string 390 val gid : group -> gid 391 val members : group -> string list 392 end 393 val getgrgid : gid -> Group.group 394 val getgrnam : string -> Group.group 395 val getpwuid : uid -> Passwd.passwd 396 val getpwnam : string -> Passwd.passwd 397end; 398 399signature POSIX_TTY = 400sig 401 eqtype pid 402 eqtype file_desc 403 structure V : 404 sig 405 val eof : int 406 val eol : int 407 val erase : int 408 val intr : int 409 val kill : int 410 val min : int 411 val quit : int 412 val susp : int 413 val time : int 414 val start : int 415 val stop : int 416 val nccs : int 417 418 type cc 419 val cc : (int * char) list -> cc 420 val update : cc * (int * char) list -> cc 421 val sub : cc * int -> char 422 end 423 structure I : 424 sig 425 include BIT_FLAGS 426 val brkint : flags 427 val icrnl : flags 428 val ignbrk : flags 429 val igncr : flags 430 val ignpar : flags 431 val inlcr : flags 432 val inpck : flags 433 val istrip : flags 434 val ixoff : flags 435 val ixon : flags 436 val parmrk : flags 437 end 438 structure O : 439 sig 440 include BIT_FLAGS 441 val opost : flags 442 end 443 structure C : 444 sig 445 include BIT_FLAGS 446 val clocal : flags 447 val cread : flags 448 val cs5 : flags 449 val cs6 : flags 450 val cs7 : flags 451 val cs8 : flags 452 val csize : flags 453 val cstopb : flags 454 val hupcl : flags 455 val parenb : flags 456 val parodd : flags 457 end 458 structure L : 459 sig 460 include BIT_FLAGS 461 val echo : flags 462 val echoe : flags 463 val echok : flags 464 val echonl : flags 465 val icanon : flags 466 val iexten : flags 467 val isig : flags 468 val noflsh : flags 469 val tostop : flags 470 end 471 eqtype speed 472 val compareSpeed : speed * speed -> order 473 val speedToWord : speed -> SysWord.word 474 val wordToSpeed : SysWord.word -> speed 475 val b0 : speed 476 val b50 : speed 477 val b75 : speed 478 val b110 : speed 479 val b134 : speed 480 val b150 : speed 481 val b200 : speed 482 val b300 : speed 483 val b600 : speed 484 val b1200 : speed 485 val b1800 : speed 486 val b2400 : speed 487 val b4800 : speed 488 val b9600 : speed 489 val b19200 : speed 490 val b38400 : speed 491 type termios 492 val termios : { 493 iflag : I.flags, 494 oflag : O.flags, 495 cflag : C.flags, 496 lflag : L.flags, 497 cc : V.cc, 498 ispeed : speed, 499 ospeed : speed 500 } -> termios 501 val fieldsOf : termios 502 -> { 503 iflag : I.flags, 504 oflag : O.flags, 505 cflag : C.flags, 506 lflag : L.flags, 507 cc : V.cc, 508 ispeed : speed, 509 ospeed : speed 510 } 511 val getiflag : termios -> I.flags 512 val getoflag : termios -> O.flags 513 val getcflag : termios -> C.flags 514 val getlflag : termios -> L.flags 515 val getcc : termios -> V.cc 516 structure CF : 517 sig 518 val getospeed : termios -> speed 519 val setospeed : termios * speed -> termios 520 val getispeed : termios -> speed 521 val setispeed : termios * speed -> termios 522 end 523 structure TC : 524 sig 525 eqtype set_action 526 val sanow : set_action 527 val sadrain : set_action 528 val saflush : set_action 529 eqtype flow_action 530 val ooff : flow_action 531 val oon : flow_action 532 val ioff : flow_action 533 val ion : flow_action 534 eqtype queue_sel 535 val iflush : queue_sel 536 val oflush : queue_sel 537 val ioflush : queue_sel 538 val getattr : file_desc -> termios 539 val setattr : file_desc * set_action * termios -> unit 540 val sendbreak : file_desc * int -> unit 541 val drain : file_desc -> unit 542 val flush : file_desc * queue_sel -> unit 543 val flow : file_desc * flow_action -> unit 544 end 545 val getpgrp : file_desc -> pid 546 val setpgrp : file_desc * pid -> unit 547end; 548 549signature POSIX = 550sig 551 structure Error : POSIX_ERROR 552 structure Signal : POSIX_SIGNAL 553 structure Process : POSIX_PROCESS 554 where type signal = Signal.signal 555 structure ProcEnv : POSIX_PROC_ENV 556 where type pid = Process.pid 557 structure FileSys : POSIX_FILE_SYS 558 where type file_desc = ProcEnv.file_desc 559 where type uid = ProcEnv.uid 560 where type gid = ProcEnv.gid 561 structure IO : POSIX_IO 562 where type pid = Process.pid 563 where type file_desc = ProcEnv.file_desc 564 where type open_mode = FileSys.open_mode 565 structure SysDB : POSIX_SYS_DB 566 where type uid = ProcEnv.uid 567 where type gid = ProcEnv.gid 568 structure TTY : POSIX_TTY 569 where type pid = Process.pid 570 where type file_desc = ProcEnv.file_desc 571end; 572 573structure Posix :> 574 sig include POSIX 575 (* I'm not sure if it's legal to use where type with 576 a datatype. The alternative is to copy the whole 577 of the signature and use datatype replication. *) 578 where type FileSys.access_mode = OS.FileSys.access_mode 579 sharing type Process.pid = ProcEnv.pid = IO.pid = TTY.pid 580 sharing type ProcEnv.uid = FileSys.uid = SysDB.uid 581 sharing type ProcEnv.gid = FileSys.gid = SysDB.gid 582 sharing type ProcEnv.file_desc = FileSys.file_desc = 583 IO.file_desc = TTY.file_desc 584 end 585 (* Posix.Signal.signal is made the same as int so that we can 586 pass the values directly to our (non-standard) Signal.signal 587 function. Since there isn't a standard way of handling 588 signals this is the best we can do. *) 589 where type Signal.signal = int 590 where type FileSys.dirstream = OS.FileSys.dirstream 591 = 592struct 593 local 594 val osSpecificGeneralCall = RunCall.rtsCallFull2 "PolyOSSpecificGeneral" 595 in 596 fun osSpecificGeneral(code: int, arg:'a):'b = RunCall.unsafeCast(osSpecificGeneralCall(RunCall.unsafeCast(code, arg))) 597 end 598 599 fun getConst i : SysWord.word = osSpecificGeneral (4, i) 600 601 structure BitFlags = 602 (* This structure is used as the basis of all the BIT_FLAGS structures. *) 603 struct 604 type flags = SysWord.word 605 fun toWord f = f 606 fun fromWord f = f 607 val flags = List.foldl (fn (a, b) => SysWord.orb(a,b)) 0w0 608 fun allSet (fl1, fl2) = SysWord.andb(fl1, fl2) = fl1 609 fun anySet (fl1, fl2) = SysWord.andb(fl1, fl2) <> 0w0 610 fun clear (fl1, fl2) = SysWord.andb(SysWord.notb fl1, fl2) 611 end 612 613 structure Error = 614 struct 615 type syserror = OS.syserror (* Implemented as a SysWord.word value. *) 616 val errorMsg = OS.errorMsg 617 618 val toWord = LibrarySupport.syserrorToWord 619 and fromWord = LibrarySupport.syserrorFromWord 620 621 val toobig = fromWord(getConst 0) 622 and acces = fromWord(getConst 1) 623 and again = fromWord(getConst 2) 624 and badf = fromWord(getConst 3) 625 and badmsg = fromWord(getConst 4) 626 and busy = fromWord(getConst 5) 627 and canceled (* sic *) = fromWord(getConst 6) 628 and child = fromWord(getConst 7) 629 and deadlk = fromWord(getConst 8) 630 and dom = fromWord(getConst 9) 631 and exist = fromWord(getConst 10) 632 and fault = fromWord(getConst 11) 633 and fbig = fromWord(getConst 12) 634 and inprogress = fromWord(getConst 13) 635 and intr = fromWord(getConst 14) 636 and inval = fromWord(getConst 15) 637 and io = fromWord(getConst 16) 638 and isdir = fromWord(getConst 17) 639 and loop = fromWord(getConst 18) 640 and mfile = fromWord(getConst 19) 641 and mlink = fromWord(getConst 20) 642 and msgsize = fromWord(getConst 21) 643 and nametoolong = fromWord(getConst 22) 644 and nfile = fromWord(getConst 23) 645 and nodev = fromWord(getConst 24) 646 and noent = fromWord(getConst 25) 647 and noexec = fromWord(getConst 26) 648 and nolck = fromWord(getConst 27) 649 and nomem = fromWord(getConst 28) 650 and nospc = fromWord(getConst 29) 651 and nosys = fromWord(getConst 30) 652 and notdir = fromWord(getConst 31) 653 and notempty = fromWord(getConst 32) 654 and notsup = fromWord(getConst 33) 655 and notty = fromWord(getConst 34) 656 and nxio = fromWord(getConst 35) 657 and perm = fromWord(getConst 36) 658 and pipe = fromWord(getConst 37) 659 and range = fromWord(getConst 38) 660 and rofs = fromWord(getConst 39) 661 and spipe = fromWord(getConst 40) 662 and srch = fromWord(getConst 41) 663 and xdev = fromWord(getConst 42) 664 665 val errNames = 666 [ 667 (acces, "acces"), 668 (again, "again"), 669 (badf, "badf"), 670 (badmsg, "badmsg"), 671 (busy, "busy"), 672 (canceled, "canceled"), 673 (child, "child"), 674 (deadlk, "deadlk"), 675 (dom, "dom"), 676 (exist, "exist"), 677 (fault, "fault"), 678 (fbig, "fbig"), 679 (inprogress, "inprogress"), 680 (intr, "intr"), 681 (inval, "inval"), 682 (io, "io"), 683 (isdir, "isdir"), 684 (loop, "loop"), 685 (mfile, "mfile"), 686 (mlink, "mlink"), 687 (msgsize, "msgsize"), 688 (nametoolong, "nametoolong"), 689 (nfile, "nfile"), 690 (nodev, "nodev"), 691 (noent, "noent"), 692 (noexec, "noexec"), 693 (nolck, "nolck"), 694 (nomem, "nomem"), 695 (nospc, "nospc"), 696 (nosys, "nosys"), 697 (notdir, "notdir"), 698 (notempty, "notempty"), 699 (notsup, "notsup"), 700 (notty, "notty"), 701 (nxio, "nxio"), 702 (perm, "perm"), 703 (pipe, "pipe"), 704 (range, "range"), 705 (rofs, "rofs"), 706 (spipe, "spipe"), 707 (srch, "srch"), 708 (toobig, "toobig"), 709 (xdev, "xdev") 710 ] 711 712 (* These are defined to return the names above. *) 713 fun errorName n = 714 case List.find (fn (e, _) => e = n) errNames of 715 SOME(_, s) => s 716 | NONE => OS.errorName n 717 718 fun syserror s = 719 case List.find (fn (_, t) => s = t) errNames of 720 SOME(e, _) => SOME e 721 | NONE => OS.syserror s 722 end; 723 724 structure Signal = 725 struct 726 type signal = int 727 val toWord = SysWord.fromInt 728 and fromWord = SysWord.toInt 729 (* These signal values are probably defined to correspond 730 to particular numbers but there's no harm in getting 731 them from the RTS. *) 732 val abrt = fromWord(getConst 43) 733 and alrm = fromWord(getConst 44) 734 and bus = fromWord(getConst 45) 735 and fpe = fromWord(getConst 46) 736 and hup = fromWord(getConst 47) 737 and ill = fromWord(getConst 48) 738 and int = fromWord(getConst 49) 739 and kill = fromWord(getConst 50) 740 and pipe = fromWord(getConst 51) 741 and quit = fromWord(getConst 52) 742 and segv = fromWord(getConst 53) 743 and term = fromWord(getConst 54) 744 and usr1 = fromWord(getConst 55) 745 and usr2 = fromWord(getConst 56) 746 and chld = fromWord(getConst 57) 747 and cont = fromWord(getConst 58) 748 and stop = fromWord(getConst 59) 749 and tstp = fromWord(getConst 60) 750 and ttin = fromWord(getConst 61) 751 and ttou = fromWord(getConst 62) 752 end; 753 754 structure Process = 755 struct 756 type signal = Signal.signal 757 type pid = int 758 val pidToWord = SysWord.fromInt 759 and wordToPid = SysWord.toInt 760 761 datatype waitpid_arg = 762 W_ANY_CHILD | W_CHILD of pid | W_SAME_GROUP | W_GROUP of pid 763 datatype exit_status = 764 W_EXITED | W_EXITSTATUS of Word8.word 765 | W_SIGNALED of signal | W_STOPPED of signal 766 datatype killpid_arg = K_PROC of pid | K_SAME_GROUP | K_GROUP of pid 767 768 structure W = 769 struct 770 open BitFlags 771 val untraced = getConst 133 772 val nohang = getConst 134 (* Not exported. *) 773 val all = flags [ untraced, nohang] 774 val intersect = List.foldl (fn (a, b) => SysWord.andb(a, b)) all 775 end 776 777 local 778 val doCall = osSpecificGeneral 779 in 780 fun fork () = 781 case doCall(5, ()) of 782 0 => NONE (* Parent *) 783 | n => SOME n (* Child *) 784 end 785 786 local 787 val doCall = osSpecificGeneral 788 in 789 (* Map the pid argument to positive, zero or 790 negative. *) 791 fun kill (K_PROC pid, si) = doCall(6,(pid, si)) 792 | kill (K_SAME_GROUP, si) = doCall(6, (0, si)) 793 | kill (K_GROUP pid, si) = doCall(6, (~pid, si)) 794 end 795 796 local 797 val doCall = osSpecificGeneral 798 in 799 (* The format of a result may well be sufficiently fixed 800 that we could decode it without calling the RTS. It's 801 probably worth the small cost to make maintenance easier. *) 802 fun fromStatus (stat: OS.Process.status): exit_status = 803 case (doCall(15, stat)) of 804 (1, 0) => W_EXITED 805 | (1, n) => W_EXITSTATUS(Word8.fromInt n) 806 | (2, n) => W_SIGNALED n 807 | (3, n) => W_STOPPED n 808 | _ => raise Fail "Unknown result status" 809 end 810 811 local 812 val doCall = osSpecificGeneral 813 fun doWait(kind: int, pid: pid, flags: W.flags list) = 814 let 815 val (pid, status) = 816 doCall(14, (kind, pid, 817 SysWord.toInt(W.flags flags))) 818 in 819 (pid, fromStatus status) 820 end 821 in 822 fun waitpid(W_ANY_CHILD, flags) = doWait(0, 0, flags) 823 | waitpid(W_CHILD pid, flags) = doWait(1, pid, flags) 824 | waitpid(W_SAME_GROUP, flags) = doWait(2, 0, flags) 825 | waitpid(W_GROUP pid, flags) = doWait(3, pid, flags) 826 827 fun wait() = waitpid(W_ANY_CHILD, []) 828 829 fun waitpid_nh(wpa, flags) = 830 let 831 val (pid, status) = waitpid(wpa, W.nohang :: flags) 832 in 833 if pid = 0 then NONE else SOME(pid, status) 834 end 835 end 836 837 fun exec(p, args) = 838 osSpecificGeneral(17, (p, args)) 839 and exece(p, args, env) = 840 osSpecificGeneral(18, (p, args, env)) 841 and execp(p, args) = 842 osSpecificGeneral(19, (p, args)) 843 844 (* This is supposed to call C "exit" function so we must use PolyFinish here. *) 845 local 846 val doExit: Word8.word -> unit = RunCall.rtsCallFull1 "PolyFinish" 847 in 848 fun exit w = 849 ( 850 doExit w; 851 raise Bind (* Never executed but gives the correct result type.*) 852 ) 853 end 854 855 local 856 val doCall = osSpecificGeneral 857 in 858 (* This previously used absolute times. Now uses relative. *) 859 fun alarm t = doCall(20, t) 860 end 861 862 local 863 (* The underlying call waits for up to a second. It takes the count of signals that 864 have been received and returns the last count. This is necessary in case 865 a signal is received while we are in ML between calls to the RTS. *) 866 val doCall: int * int -> int = RunCall.rtsCallFull2 "PolyPosixSleep" 867 in 868 (* Sleep for a period. Returns the unused wait time. *) 869 fun sleep sleepTime = 870 let 871 val endTime = sleepTime + Time.now() 872 val maxWait = 1000 (* Wait for up to a second *) 873 val initialCount = doCall (0, 0) 874 fun doWait () = 875 let 876 val timeToGo = 877 LargeInt.min(Time.toMilliseconds(endTime-Time.now()), LargeInt.fromInt maxWait) 878 in 879 if timeToGo <= 0 orelse doCall(LargeInt.toInt timeToGo, initialCount) <> initialCount 880 then (* Time has expired or we were interrupted. *) 881 let 882 val now = Time.now() 883 in 884 if endTime > now 885 then endTime-now 886 else Time.fromSeconds 0 887 end 888 else doWait() (* Resume the wait *) 889 end 890 in 891 doWait() 892 end 893 894 and pause() = 895 let 896 val initialCount = doCall(0, 0) 897 fun doPause() = if doCall(1000, initialCount) <> initialCount then () else doPause() 898 in 899 doPause() 900 end 901 end 902 end; 903 904 structure ProcEnv = 905 struct 906 type pid = Process.pid and file_desc = OS.IO.iodesc 907 type uid = int and gid = int 908 val uidToWord = SysWord.fromInt 909 and wordToUid = SysWord.toInt 910 and gidToWord = SysWord.fromInt 911 and wordToGid = SysWord.toInt 912 913 local 914 val doCall = osSpecificGeneral 915 in 916 fun getpid () = doCall(7, ()) 917 and getppid () = doCall(8, ()) 918 and getuid () = doCall(9, ()) 919 and geteuid () = doCall(10, ()) 920 and getgid () = doCall(11, ()) 921 and getegid () = doCall(12, ()) 922 and getpgrp () = doCall(13, ()) 923 and setsid () = doCall(27, ()) 924 end 925 926 val getenv = OS.Process.getEnv 927 928 val environ = RunCall.rtsCallFull0 "PolyGetEnvironment" 929 930 local 931 val doCall = osSpecificGeneral 932 in 933 fun setuid(u: uid) = doCall(23, u) 934 and setgid(g: gid) = doCall(24, g) 935 end 936 937 local 938 val doCall = osSpecificGeneral 939 in 940 fun getgroups() = doCall(25, ()) 941 end 942 943 local 944 val doCall = osSpecificGeneral 945 in 946 fun getlogin() = doCall(26, ()) 947 and ctermid() = doCall(30, ()) 948 end 949 950 local 951 val doCall = osSpecificGeneral 952 in 953 (* In each case NONE as an argument is taken as 0. *) 954 fun setpgid{pid, pgid} = doCall(28, (getOpt(pid, 0), getOpt(pgid, 0))) 955 end 956 957 local 958 val doCall = osSpecificGeneral 959 in 960 fun uname() = doCall(29, ()) 961 end 962 963 val time = Time.now 964 965 local 966 (* Apart from the child times all these could be obtained by calling the Timer functions. *) 967 val getUserTime: unit -> Time.time = RunCall.rtsCallFull0 "PolyTimingGetUser" 968 and getSysTime: unit -> Time.time = RunCall.rtsCallFull0 "PolyTimingGetSystem" 969 and getRealTime: unit -> Time.time = RunCall.rtsCallFull0 "PolyTimingGetReal" 970 and getChildUserTime: unit -> Time.time = RunCall.rtsCallFull0 "PolyTimingGetChildUser" 971 and getChildSysTime: unit -> Time.time = RunCall.rtsCallFull0 "PolyTimingGetChildSystem" 972 in 973 fun times() = 974 { elapsed=getRealTime(), utime=getUserTime(), stime=getSysTime(), 975 cutime=getChildUserTime(), cstime=getChildSysTime()} 976 end 977 978 local 979 val doCall = osSpecificGeneral 980 in 981 fun ttyname(f: file_desc) = doCall(31, f) 982 end 983 984 local 985 val doCall = osSpecificGeneral 986 in 987 fun isatty(f: file_desc) = doCall(32, f) 988 end 989 990 local 991 val doCall = osSpecificGeneral 992 in 993 fun sysconf(s: string) = SysWord.fromInt(doCall(33, s)) 994 end 995 end; 996 997 structure FileSys = 998 struct 999 type uid = ProcEnv.uid and gid = ProcEnv.gid 1000 type file_desc = OS.IO.iodesc 1001 type dirstream = OS.FileSys.dirstream 1002 datatype open_mode = O_RDONLY | O_WRONLY | O_RDWR 1003 1004 structure O = 1005 struct 1006 open BitFlags 1007 val append = getConst 66 1008 and excl = getConst 67 1009 and noctty = getConst 68 1010 and nonblock = getConst 69 1011 and sync = getConst 70 1012 and trunc = getConst 71 1013 val all = flags [append, excl, noctty, nonblock, sync, trunc] 1014 val intersect = List.foldl (fn (a, b) => SysWord.andb(a, b)) all 1015 end 1016 1017 local 1018 val doIo: int*file_desc*unit -> int = RunCall.rtsCallFull3 "PolyBasicIOGeneral" 1019 in 1020 fun fdToWord (f: file_desc) = SysWord.fromInt(doIo(30, f, ())) 1021 end 1022 1023 (* file_desc and OS.IO.iodesc are the same. *) 1024 fun fdToIOD i = i 1025 and iodToFD i = SOME i 1026 1027 val opendir = OS.FileSys.openDir 1028 and readdir = OS.FileSys.readDir 1029 and rewinddir = OS.FileSys.rewindDir 1030 and closedir = OS.FileSys.closeDir 1031 and chdir = OS.FileSys.chDir 1032 and getcwd = OS.FileSys.getDir 1033 and unlink = OS.FileSys.remove 1034 and rmdir = OS.FileSys.rmDir 1035 and rename = OS.FileSys.rename 1036 and readlink = OS.FileSys.readLink 1037 1038 local 1039 val persistentFD: int -> file_desc = RunCall.rtsCallFull1 "PolyPosixCreatePersistentFD" 1040 in 1041 (* Use persistent file descriptors here. i.e. don't reset them to "invalid" if they are 1042 read into a new session. We always want that for 0, 1 and 2 but it's not clear whether 1043 that is correct for other file descriptors. Since this is a low-level function 1044 assume that the caller understands the issues. *) 1045 val wordToFD = persistentFD o SysWord.toInt 1046 end 1047 1048 val stdin = wordToFD 0w0 (* Must be persistent. *) 1049 and stdout = wordToFD 0w1 1050 and stderr = wordToFD 0w2 1051 1052 structure S = 1053 struct 1054 open BitFlags 1055 type mode = flags 1056 val irusr : mode = getConst 145 1057 and iwusr : mode = getConst 146 1058 and ixusr : mode = getConst 147 1059 val irwxu : mode = flags[irusr, iwusr, ixusr] 1060 val irgrp : mode = getConst 148 1061 and iwgrp : mode = getConst 149 1062 and ixgrp : mode = getConst 150 1063 val irwxg : mode = flags[irgrp, iwgrp, ixgrp] 1064 val iroth : mode = getConst 151 1065 and iwoth : mode = getConst 152 1066 and ixoth : mode = getConst 153 1067 val irwxo : mode = flags[iroth, iwoth, ixoth] 1068 val isuid : mode = getConst 154 1069 val isgid : mode = getConst 155 1070 val all = flags [irwxu, irwxg, irwxo, isuid, isgid] 1071 val intersect = List.foldl (fn (a, b) => SysWord.andb(a, b)) all 1072 end 1073 1074 local 1075 val o_rdonly = getConst 63 1076 and o_wronly = getConst 64 1077 and o_rdwr = getConst 65 1078 1079 fun toBits O_RDONLY = o_rdonly 1080 | toBits O_WRONLY = o_wronly 1081 | toBits O_RDWR = o_rdwr 1082 1083 val doIo = RunCall.rtsCallFull3 "PolyBasicIOGeneral" 1084 in 1085 fun openf(name, mode, flags) = 1086 let 1087 val bits = SysWord.orb(flags, toBits mode) 1088 in 1089 doIo(70, 0, (name, SysWord.toInt bits, 0)) 1090 end 1091 1092 and createf(name, mode, flags, smode) = 1093 let 1094 val bits = SysWord.orb(flags, toBits mode) 1095 in 1096 doIo(71, 0, (name, SysWord.toInt bits, SysWord.toInt smode)) 1097 end 1098 end 1099 1100 fun creat(s, m) = createf(s, O_WRONLY, O.trunc, m) 1101 1102 local 1103 val doCall = osSpecificGeneral 1104 in 1105 fun umask m = SysWord.fromInt(doCall(50, SysWord.toInt m)) 1106 end 1107 1108 local 1109 val doCall = osSpecificGeneral 1110 in 1111 fun link{old, new} = doCall(51, (old, new)) 1112 and symlink{old, new} = doCall(54, (old, new)) 1113 end 1114 1115 local 1116 val doCall = osSpecificGeneral 1117 in 1118 fun mkdir(name, mode) = doCall(52, (name, SysWord.toInt mode)) 1119 and mkfifo(name, mode) = doCall(53, (name, SysWord.toInt mode)) 1120 and chmod(name, mode) = doCall(59, (name, SysWord.toInt mode)) 1121 end 1122 1123 type dev = LargeInt.int and ino = LargeInt.int 1124 val wordToDev = SysWord.toLargeInt 1125 and devToWord = SysWord.fromLargeInt 1126 and wordToIno = SysWord.toLargeInt 1127 and inoToWord = SysWord.fromLargeInt 1128 1129 structure ST = 1130 struct 1131 type stat = { mode: S.mode, kind: int, ino: ino, dev: dev, 1132 nlink: int, uid: uid, gid: gid, size: Position.int, 1133 atime: Time.time, mtime: Time.time, ctime: Time.time } 1134 (* The "kind" information is encoded by "stat" *) 1135 fun isDir({ kind, ...} : stat) = kind = 1 1136 and isChr({ kind, ...} : stat) = kind = 2 1137 and isBlk({ kind, ...} : stat) = kind = 3 1138 and isReg({ kind, ...} : stat) = kind = 0 1139 and isFIFO({ kind, ...} : stat) = kind = 4 1140 and isLink({ kind, ...} : stat) = kind = 5 1141 and isSock({ kind, ...} : stat) = kind = 6 1142 1143 val mode : stat -> S.mode = #mode 1144 and ino : stat -> ino = #ino 1145 val dev : stat -> dev = #dev 1146 val nlink : stat -> int = #nlink 1147 val uid : stat -> uid = #uid 1148 val gid : stat -> gid = #gid 1149 val size : stat -> Position.int = #size 1150 val atime : stat -> Time.time = #atime 1151 val mtime : stat -> Time.time = #mtime 1152 val ctime : stat -> Time.time = #ctime 1153 end 1154 1155 local 1156 val doCall1 = osSpecificGeneral 1157 val doCall2 = osSpecificGeneral 1158 fun convStat(mode, kind, ino, dev, nlink, uid, gid, size, 1159 atime, mtime, ctime) = 1160 { mode = SysWord.fromInt mode, kind = kind, ino = ino, 1161 dev = dev, nlink = nlink, uid = uid, gid = gid, 1162 size = size, atime = atime, mtime = mtime, ctime = ctime } 1163 in 1164 fun stat name = convStat(doCall1(55, name)) 1165 and lstat name = convStat(doCall1(56, name)) 1166 and fstat f = convStat(doCall2(57, f)) 1167 end 1168 1169 1170 datatype access_mode = datatype OS.FileSys.access_mode 1171 1172 local 1173 val doCall = osSpecificGeneral 1174 val rOK = getConst 156 and wOK = getConst 157 1175 and eOK = getConst 158 and fOK = getConst 159 1176 fun abit A_READ = rOK 1177 | abit A_WRITE = wOK 1178 | abit A_EXEC = eOK 1179 val abits = List.foldl (fn (a, b) => SysWord.orb(abit a,b)) 0w0 1180 in 1181 (* If the bits are nil it tests for existence of the file. *) 1182 fun access(name, []) = doCall(58, (name, SysWord.toInt(fOK))) 1183 | access(name, al) = doCall(58, (name, SysWord.toInt(abits al))) 1184 1185 end 1186 1187 local 1188 val doCall = osSpecificGeneral 1189 in 1190 fun fchmod(fd, mode) = doCall(60, (fd, SysWord.toInt mode)) 1191 end 1192 local 1193 val doCall = osSpecificGeneral 1194 in 1195 fun chown(name, uid, gid) = doCall(61, (name, uid, gid)) 1196 end 1197 local 1198 val doCall = osSpecificGeneral 1199 in 1200 fun fchown(fd, uid, gid) = doCall(62, (fd, uid, gid)) 1201 end 1202 local 1203 val doCall1 = osSpecificGeneral 1204 and doCall2 = osSpecificGeneral 1205 in 1206 fun utime (name, NONE) = doCall1(64, name) 1207 | utime (name, SOME{actime, modtime}) = 1208 doCall2(63, (name, actime, modtime)) 1209 end 1210 local 1211 val doCall = osSpecificGeneral 1212 in 1213 fun ftruncate(fd, size) = doCall(65, (fd, size)) 1214 end 1215 1216 local 1217 val doCall = osSpecificGeneral 1218 in 1219 fun pathconf(name, var) = 1220 let 1221 val res = doCall(66, (name, var)) 1222 in 1223 if res < 0 then NONE 1224 else SOME(SysWord.fromInt res) 1225 end 1226 end 1227 local 1228 val doCall = osSpecificGeneral 1229 in 1230 fun fpathconf(fd, var) = 1231 let 1232 val res = doCall(67, (fd, var)) 1233 in 1234 if res < 0 then NONE 1235 else SOME(SysWord.fromInt res) 1236 end 1237 end 1238 end; 1239 1240 structure IO = 1241 struct 1242 type file_desc = OS.IO.iodesc and pid = Process.pid 1243 structure FD = 1244 struct 1245 open BitFlags 1246 val cloexec: flags = getConst 132 1247 val all = flags [cloexec] 1248 val intersect = List.foldl (fn (a, b) => SysWord.andb(a, b)) all 1249 end 1250 1251 (* Posix.IO.O seems to be a cut-down version of Posix.FileSys.O. 1252 It seems to me that one structure would suffice. *) 1253 structure O = FileSys.O 1254 1255 datatype open_mode = datatype FileSys.open_mode 1256 1257 local 1258 val doIo = RunCall.rtsCallFull3 "PolyBasicIOGeneral" 1259 in 1260 fun close (strm: file_desc): unit = doIo(7, strm, 0) 1261 end 1262 1263 local 1264 val doIo = RunCall.rtsCallFull3 "PolyBasicIOGeneral" 1265 in 1266 fun readVec (strm: file_desc, len: int): Word8Vector.vector = 1267 doIo(26, strm, len) 1268 end 1269 1270 local 1271 val doCall = osSpecificGeneral 1272 in 1273 fun pipe() = 1274 let 1275 val (inf, outf) = doCall(110, ()) 1276 in 1277 { infd=inf, outfd=outf } 1278 end 1279 end 1280 1281 local 1282 val doCall = osSpecificGeneral 1283 in 1284 fun dup fd = doCall(111, fd) 1285 end 1286 1287 local 1288 val doCall = osSpecificGeneral 1289 in 1290 fun dup2{old, new} = doCall(112, (old, new)) 1291 end 1292 1293 local 1294 val doCall = osSpecificGeneral 1295 in 1296 fun dupfd{old, base} = doCall(113, (old, base)) 1297 end 1298 1299 local 1300 val doCall = osSpecificGeneral 1301 val o_rdonly = getConst 63 1302 and o_wronly = getConst 64 1303 and o_accmode = getConst 166 (* Access mode mask. *) 1304 in 1305 fun getfd fd = SysWord.fromInt(doCall(114, fd)) 1306 and getfl fd = 1307 let 1308 val res = SysWord.fromInt(doCall(116, fd)) 1309 (* Separate out the mode bits. *) 1310 val flgs = SysWord.andb(res, SysWord.notb o_accmode) 1311 val mode = SysWord.andb(res, o_accmode) 1312 val omode = if mode = o_rdonly then O_RDONLY 1313 else if mode = o_wronly then O_WRONLY 1314 else O_RDWR 1315 in 1316 (flgs, omode) 1317 end 1318 end 1319 local 1320 val doCall = osSpecificGeneral 1321 in 1322 fun setfd(fd, flags) = doCall(115, (fd, SysWord.toInt flags)) 1323 and setfl(fd, flags) = doCall(117, (fd, SysWord.toInt flags)) 1324 end 1325 1326 datatype whence = SEEK_SET | SEEK_CUR | SEEK_END 1327 1328 local 1329 val seekSet = SysWord.toInt(getConst 160) 1330 and seekCur = SysWord.toInt(getConst 161) 1331 and seekEnd = SysWord.toInt(getConst 162) 1332 in 1333 (* Convert the datatype to the corresponding int. *) 1334 fun seekWhence SEEK_SET = seekSet 1335 | seekWhence SEEK_CUR = seekCur 1336 | seekWhence SEEK_END = seekEnd 1337 fun whenceSeek s = 1338 if s = seekSet then SEEK_SET 1339 else if s = seekCur then SEEK_CUR 1340 else SEEK_END 1341 end 1342 local 1343 val doCall = osSpecificGeneral 1344 in 1345 fun lseek(fd, pos, whence) = doCall(118, (fd, pos, seekWhence whence)) 1346 end 1347 1348 local 1349 val doCall = osSpecificGeneral 1350 in 1351 fun fsync fd = doCall(119, fd) 1352 end 1353 1354 datatype lock_type = F_RDLCK | F_WRLCK | F_UNLCK 1355 1356 structure FLock = 1357 struct 1358 val fRdlck = SysWord.toInt(getConst 163) 1359 and fWrlck = SysWord.toInt(getConst 164) 1360 and fUnlck = SysWord.toInt(getConst 165) 1361 1362 type flock = int (* lock type *) * 1363 int (* whence *) * 1364 Position.int (* start *) * 1365 Position.int (* len *) * 1366 pid 1367 1368 fun flock{ltype, whence, start, len, pid} = 1369 let 1370 val lt = 1371 case ltype of 1372 F_RDLCK => fRdlck 1373 | F_WRLCK => fWrlck 1374 | F_UNLCK => fUnlck 1375 in 1376 (lt, seekWhence whence, start, len, getOpt(pid, ~1)) 1377 end 1378 1379 fun ltype (lt, _, _, _, _) = 1380 if lt = fRdlck then F_RDLCK 1381 else if lt = fWrlck then F_WRLCK 1382 else F_UNLCK 1383 1384 fun whence (fl: flock) = whenceSeek(#2 fl) 1385 val start : flock -> Position.int = #3 1386 val len : flock -> Position.int = #4 1387 fun pid (_, _, _, _, pid) = if pid < 0 then NONE else SOME pid 1388 end 1389 1390 local 1391 val doCall = osSpecificGeneral 1392 in 1393 fun getlk(fd, (t, w, s, l, p)) = doCall(120, (fd, t, w, s, l, p)) 1394 (* Note: the return type of setlk and setlkw is Flock.lock 1395 not unit. I assume they simply return their argument. *) 1396 and setlk(fd, (t, w, s, l, p)) = doCall(121, (fd, t, w, s, l, p)) 1397 and setlkw(fd, (t, w, s, l, p)) = doCall(122, (fd, t, w, s, l, p)) 1398 end 1399 1400 val readArr = LibraryIOSupport.readBinArray 1401 and writeVec = LibraryIOSupport.writeBinVec 1402 and writeArr = LibraryIOSupport.writeBinArray 1403 1404 val mkTextReader = LibraryIOSupport.wrapInFileDescr 1405 and mkTextWriter = LibraryIOSupport.wrapOutFileDescr 1406 val mkBinReader = LibraryIOSupport.wrapBinInFileDescr 1407 and mkBinWriter = LibraryIOSupport.wrapBinOutFileDescr 1408 end; 1409 1410 structure SysDB = 1411 struct 1412 type uid = ProcEnv.uid and gid = ProcEnv.gid 1413 structure Passwd = 1414 struct 1415 type passwd = string * uid * gid * string * string 1416 val name: passwd->string = #1 1417 and uid: passwd->uid = #2 1418 and gid: passwd->gid = #3 1419 and home: passwd->string = #4 1420 and shell: passwd->string = #5 1421 end 1422 structure Group = 1423 struct 1424 type group = string * gid * string list 1425 val name: group->string = #1 1426 and gid: group->gid = #2 1427 and members: group->string list = #3 1428 end 1429 1430 local 1431 val doCall = osSpecificGeneral 1432 in 1433 fun getpwnam (s: string): Passwd.passwd = doCall(100, s) 1434 end 1435 local 1436 val doCall = osSpecificGeneral 1437 in 1438 fun getpwuid (u: uid): Passwd.passwd = doCall(101, u) 1439 end 1440 local 1441 val doCall = osSpecificGeneral 1442 in 1443 fun getgrnam (s: string): Group.group = doCall(102, s) 1444 end 1445 local 1446 val doCall = osSpecificGeneral 1447 in 1448 fun getgrgid (g: gid): Group.group = doCall(103, g) 1449 end 1450 end; 1451 1452 structure TTY = 1453 struct 1454 type pid = Process.pid and file_desc = OS.IO.iodesc 1455 1456 structure V = 1457 struct 1458 val eof = SysWord.toInt(getConst 72) 1459 and eol = SysWord.toInt(getConst 73) 1460 and erase = SysWord.toInt(getConst 74) 1461 and intr = SysWord.toInt(getConst 75) 1462 and kill = SysWord.toInt(getConst 76) 1463 and min = SysWord.toInt(getConst 77) 1464 and quit = SysWord.toInt(getConst 78) 1465 and susp = SysWord.toInt(getConst 79) 1466 and time = SysWord.toInt(getConst 80) 1467 and start = SysWord.toInt(getConst 81) 1468 and stop = SysWord.toInt(getConst 82) 1469 and nccs = SysWord.toInt(getConst 83) 1470 1471 type cc = string 1472 1473 fun cc l = 1474 (* Generate a string using the values given and 1475 defaulting the rest to NULL. *) 1476 let 1477 fun find [] _ = #"\000" 1478 | find ((n, c)::l) i = 1479 if i = n then c else find l i 1480 in 1481 CharVector.tabulate(nccs, find l) 1482 end 1483 1484 (* Question: What order does this take? E.g. What is 1485 the result of update(cc, [(eof, #"a"), (eof, #"b")]) ? 1486 Assume that earlier entries take precedence. That 1487 also affects the processing of exceptions. *) 1488 fun update(cc, l) = 1489 let 1490 fun find [] i = String.sub(cc, i) 1491 | find ((n, c)::l) i = 1492 if i = n then c else find l i 1493 in 1494 CharVector.tabulate(nccs, find l) 1495 end 1496 1497 val sub = String.sub 1498 end 1499 1500 structure I = 1501 struct 1502 open BitFlags 1503 val brkint = getConst 84 1504 and icrnl = getConst 85 1505 and ignbrk = getConst 86 1506 and igncr = getConst 87 1507 and ignpar = getConst 88 1508 and inlcr = getConst 89 1509 and inpck = getConst 90 1510 and istrip = getConst 91 1511 and ixoff = getConst 92 1512 and ixon = getConst 93 1513 and parmrk = getConst 94 1514 val all = flags [brkint, icrnl, ignbrk, igncr, ignpar, 1515 inlcr, inpck, istrip, ixoff, ixon, parmrk] 1516 val intersect = List.foldl (fn (a, b) => SysWord.andb(a, b)) all 1517 end 1518 1519 structure O = 1520 struct 1521 open BitFlags 1522 val opost = getConst 95 1523 val all = flags [opost] 1524 val intersect = List.foldl (fn (a, b) => SysWord.andb(a, b)) all 1525 end 1526 1527 structure C = 1528 struct 1529 open BitFlags 1530 val clocal = getConst 96 1531 and cread = getConst 97 1532 and cs5 = getConst 98 1533 and cs6 = getConst 99 1534 and cs7 = getConst 100 1535 and cs8 = getConst 101 1536 and csize = getConst 102 1537 and cstopb = getConst 103 1538 and hupcl = getConst 104 1539 and parenb = getConst 105 1540 and parodd = getConst 106 1541 val all = flags [clocal, cread, cs5, cs6, cs7, cs8, csize, 1542 cstopb, hupcl, parenb, parodd] 1543 val intersect = List.foldl (fn (a, b) => SysWord.andb(a, b)) all 1544 end 1545 1546 structure L = 1547 struct 1548 open BitFlags 1549 val echo = getConst 107 1550 and echoe = getConst 108 1551 and echok = getConst 109 1552 and echonl = getConst 110 1553 and icanon = getConst 111 1554 and iexten = getConst 112 1555 and isig = getConst 113 1556 and noflsh = getConst 114 1557 and tostop = getConst 115 1558 val all = flags [echo, echoe, echok, echonl, icanon, 1559 iexten, isig, noflsh, tostop] 1560 val intersect = List.foldl (fn (a, b) => SysWord.andb(a, b)) all 1561 end 1562 1563 type speed = int 1564 (* compareSpeed is supposed to compare by the baud rate, not 1565 by the encoding. Provided the encoding maintains the 1566 ordering then that's fine. Maybe we should have an RTS call. *) 1567 val compareSpeed : speed * speed -> order = Int.compare 1568 and speedToWord : speed -> SysWord.word = SysWord.fromInt 1569 and wordToSpeed : SysWord.word -> speed = SysWord.toInt 1570 val b0 : speed = SysWord.toInt(getConst 116) 1571 and b50 : speed = SysWord.toInt(getConst 117) 1572 and b75 : speed = SysWord.toInt(getConst 118) 1573 and b110 : speed = SysWord.toInt(getConst 119) 1574 and b134 : speed = SysWord.toInt(getConst 120) 1575 and b150 : speed = SysWord.toInt(getConst 121) 1576 and b200 : speed = SysWord.toInt(getConst 122) 1577 and b300 : speed = SysWord.toInt(getConst 123) 1578 and b600 : speed = SysWord.toInt(getConst 124) 1579 and b1200 : speed = SysWord.toInt(getConst 125) 1580 and b1800 : speed = SysWord.toInt(getConst 126) 1581 and b2400 : speed = SysWord.toInt(getConst 127) 1582 and b4800 : speed = SysWord.toInt(getConst 128) 1583 and b9600 : speed = SysWord.toInt(getConst 129) 1584 and b19200 : speed = SysWord.toInt(getConst 130) 1585 and b38400 : speed = SysWord.toInt(getConst 131) 1586 1587 type termios = { 1588 iflag : I.flags, 1589 oflag : O.flags, 1590 cflag : C.flags, 1591 lflag : L.flags, 1592 cc : V.cc, 1593 ispeed : speed, 1594 ospeed : speed 1595 } 1596 fun termios t = t 1597 and fieldsOf t = t 1598 val getiflag : termios -> I.flags = #iflag 1599 and getoflag : termios -> O.flags = #oflag 1600 and getcflag : termios -> C.flags = #cflag 1601 and getlflag : termios -> L.flags = #lflag 1602 and getcc : termios -> V.cc = #cc 1603 1604 structure CF = 1605 struct 1606 val getospeed : termios -> speed = #ospeed 1607 and getispeed : termios -> speed = #ispeed 1608 fun setospeed ({ iflag, oflag, cflag, lflag, cc, ispeed, ... }, speed) = 1609 { iflag=iflag, oflag=oflag, cflag=cflag, lflag=lflag, 1610 cc=cc, ispeed = ispeed, ospeed = speed } 1611 fun setispeed ({ iflag, oflag, cflag, lflag, cc, ospeed, ... }, speed) = 1612 { iflag=iflag, oflag=oflag, cflag=cflag, lflag=lflag, 1613 cc=cc, ispeed = speed, ospeed = ospeed } 1614 end 1615 1616 structure TC = 1617 struct 1618 type set_action = int 1619 val sanow : set_action = SysWord.toInt(getConst 135) 1620 val sadrain : set_action = SysWord.toInt(getConst 136) 1621 val saflush : set_action = SysWord.toInt(getConst 137) 1622 1623 type flow_action = int 1624 val ooff : flow_action = SysWord.toInt(getConst 138) 1625 val oon : flow_action = SysWord.toInt(getConst 139) 1626 val ioff : flow_action = SysWord.toInt(getConst 140) 1627 val ion : flow_action = SysWord.toInt(getConst 141) 1628 1629 type queue_sel = int 1630 val iflush : queue_sel = SysWord.toInt(getConst 142) 1631 val oflush : queue_sel = SysWord.toInt(getConst 143) 1632 val ioflush : queue_sel = SysWord.toInt(getConst 144) 1633 1634 local 1635 val doCall = osSpecificGeneral 1636 in 1637 fun getattr f = 1638 let 1639 val (iflag, oflag, cflag, lflag, cc, ispeed, ospeed) 1640 = doCall(150, f) 1641 in 1642 { 1643 iflag=SysWord.fromInt iflag, 1644 oflag=SysWord.fromInt oflag, 1645 cflag=SysWord.fromInt cflag, 1646 lflag=SysWord.fromInt lflag, 1647 cc=cc, 1648 ispeed = ispeed, 1649 ospeed = ospeed } 1650 end 1651 end 1652 1653 local 1654 val doCall = osSpecificGeneral 1655 in 1656 fun setattr (f, sa, 1657 {iflag, oflag, cflag, lflag, cc, ispeed, ospeed}) = 1658 doCall(151, (f, sa, SysWord.toInt iflag, 1659 SysWord.toInt oflag, SysWord.toInt cflag, 1660 SysWord.toInt lflag, cc, ispeed, ospeed)) 1661 end 1662 1663 local 1664 val doCall = osSpecificGeneral 1665 in 1666 fun sendbreak (f, d) = doCall(152, (f, d)) 1667 end 1668 local 1669 val doCall = osSpecificGeneral 1670 in 1671 fun drain f = doCall(153, f) 1672 end 1673 local 1674 val doCall = osSpecificGeneral 1675 in 1676 fun flush (f, qs) = doCall(154, (f, qs)) 1677 end 1678 local 1679 val doCall = osSpecificGeneral 1680 in 1681 fun flow (f, fa) = doCall(155, (f, fa)) 1682 end 1683 end 1684 1685 local 1686 val doCall = osSpecificGeneral 1687 in 1688 fun getpgrp (f: file_desc): pid = doCall(156, f) 1689 end 1690 local 1691 val doCall = osSpecificGeneral 1692 in 1693 fun setpgrp (f: file_desc, p: pid): unit = doCall(157, (f,p)) 1694 end 1695 end 1696end; 1697 1698local 1699 (* Install the pretty printers for pid, uid, gid. Don't install one for signal 1700 because it's now the same as int. *) 1701 fun ppid _ _ x = PolyML.PrettyString(Int.toString(SysWord.toInt(Posix.Process.pidToWord x))) 1702 and puid _ _ x = PolyML.PrettyString(Int.toString(SysWord.toInt(Posix.ProcEnv.uidToWord x))) 1703 and pgid _ _ x = PolyML.PrettyString(Int.toString(SysWord.toInt(Posix.ProcEnv.gidToWord x))) 1704in 1705 val () = PolyML.addPrettyPrinter ppid 1706 val () = PolyML.addPrettyPrinter puid 1707 val () = PolyML.addPrettyPrinter pgid 1708end; 1709