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/Unsafe/cinterface.sml
ViewVC logotype

View of /sml/trunk/src/compiler/PervEnv/Unsafe/cinterface.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 114 - (download) (annotate)
Fri Jun 5 19:41:21 1998 UTC (22 years, 2 months ago) by monnier
File size: 972 byte(s)
This commit was generated by cvs2svn to compensate for changes in r113,
which included commits to RCS files with non-trunk default branches.
(* cinterface.sml
 *
 * COPYRIGHT (c) 1994 AT&T Bell Laboratories.
 *
 *)

structure CInterface :> CINTERFACE =
  struct

    type c_function = Assembly.A.c_function

    val bindCFun = Assembly.A.bind_cfun

    exception CFunNotFound of string

    fun c_function moduleName funName = let
	  val cfun = bindCFun (moduleName, funName)
	  in
	    if (InlineT.cast cfun <> 0)
	      then fn x => (Assembly.A.callc (cfun, x))
	      else raise CFunNotFound(String.concat[moduleName, ".", funName])
	  end

    type system_const = (int * string)

    exception SysConstNotFound of string

    fun findSysConst (name, l) = let
	  fun look [] = NONE
	    | look ((sysConst : system_const)::r) = if (#2 sysConst = name)
		then SOME sysConst
		else look r
	  in
	    look l
	  end

    fun bindSysConst (name, l) = (case findSysConst(name, l)
	   of (SOME sc) => sc
	    | NONE => raise(SysConstNotFound name)
	  (* end case *))

  end (* structure CInterface *)

(*
 * $Log$
 *)

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0