Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] View of /sml/trunk/src/compiler/PervEnv/Win32/os-io.sml
ViewVC logotype

View of /sml/trunk/src/compiler/PervEnv/Win32/os-io.sml

Parent Directory Parent Directory | Revision Log Revision Log

Revision 144 - (download) (annotate)
Mon Sep 7 21:46:44 1998 UTC (21 years, 9 months ago) by monnier
File size: 2559 byte(s)
This commit was generated by cvs2svn to compensate for changes in r143,
which included commits to RCS files with non-trunk default branches.
(* os-io.sml
 * COPYRIGHT (c) 1998 Bell Labs, Lucent Technologies.
 * COPYRIGHT (c) 1996 Bell Laboratories.
 * Replacement OS.IO structure for Win32.
 * It implements a simple type of polling for file objects.
 * This file requires a runtime system supporting polling in Win32-IO.

structure OS_IO : OS_IO = 
	structure W32G = Win32_General
	structure W32FS = Win32_FileSys
	type word32 = Word32.word

	exception SysErr = Assembly.SysErr

	type iodesc = OS.IO.iodesc (* IODesc of W32G.hndl ref *) 

	(* hash: can't assume 32 bits *)
	fun hash (OS.IO.IODesc (ref (0wxffffffff : W32G.hndl))) = 
	    0wx7fffffff : word 
	  | hash (OS.IO.IODesc (ref h)) = (Word.fromInt o W32G.Word.toInt) h

	fun compare (OS.IO.IODesc (ref wa),OS.IO.IODesc (ref wb)) = 

        datatype iodesc_kind = K of string

	structure Kind =
		val file = K "FILE"
		val dir = K "DIR"
		val symlink = K "LINK"
		val tty = K "TTY"
		val pipe = K "PIPE"
		val socket = K "SOCK"
		val device = K "DEV"

	fun kind (OS.IO.IODesc (ref h)) = 
	    case W32FS.getFileAttributes' h of
		NONE => 
		    K "UNKNOWN"
	      | SOME w =>
		    if W32FS.isRegularFile h then Kind.file
		    else Kind.dir

        (* no win32 polling devices for now *)
	val noPolling = "polling not implemented for win32 for this device/type"

	datatype poll_desc = PollDesc of iodesc
	datatype poll_info = PollInfo of poll_desc
	fun pollDesc id = SOME (PollDesc id) (* NONE *)
	fun pollToIODesc (PollDesc pd) = pd (* raise Fail("pollToIODesc: "^noPolling) *)
	exception Poll

	fun pollIn pd = pd (* raise Fail("pollIn: "^noPolling) *)
	fun pollOut pd = pd (* raise Fail("pollOut: "^noPolling) *)
	fun pollPri pd = pd (* raise Fail("pollPri: "^noPolling) *)

	    val poll' : (word32 list * (Int32.int * int) option -> word32 list) = 
		CInterface.c_function "WIN32-IO" "poll"
	    fun toPollInfo (w) = PollInfo (PollDesc (OS.IO.IODesc (ref w)))
	    fun fromPollDesc (PollDesc (OS.IO.IODesc (ref w))) = w
	    fun poll (pdl,t) = 
		let val timeout = (case t
				     of SOME (t) => SOME (Time.toSeconds (t),
							  Int.fromLarge (Time.toMicroseconds t))
				      | NONE => NONE)
		    val info = poll' (List.map fromPollDesc pdl,timeout)
		    List.map toPollInfo info
	fun isIn pd = raise Fail("isIn: "^noPolling)
	fun isOut pd = raise Fail("isOut: "^noPolling)
	fun isPri pd = raise Fail("isPri: "^noPolling)

	fun infoToPollDesc (PollInfo pd) = pd (* raise Fail("infoToPollDesc: "^noPolling) *)

ViewVC Help
Powered by ViewVC 1.0.0