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