Updating: very minorly fixing

Updating: very minorly fixing

(*
** Implementing the doublet game
*)

(* ****** ****** *)
//
#include
"share/atspre_staload.hats"
//
(* ****** ****** *)
//
staload UN =
"prelude/SATS/unsafe.sats"
//
(* ****** ****** *)
//
staload "libats/SATS/qlist.sats"
//
staload _ = "libats/DATS/qlist.dats"
//
(* ****** ****** *)
//
staload "libats/ML/SATS/basis.sats"
staload "libats/ML/SATS/list0.sats"
staload "libats/ML/SATS/strarr.sats"
//
staload _ = "libats/ML/DATS/list0.dats"
staload _ = "libats/ML/DATS/array0.dats"
staload _ = "libats/ML/DATS/strarr.dats"
//
(* ****** ****** *)
//
staload "libats/ML/SATS/funset.sats"
//
staload _ = "libats/ML/DATS/funset.dats"
staload _ = "libats/DATS/funset_avltree.dats"
//
(* ****** ****** *)

staload "./doublet.sats"

(* ****** ****** *)

typedef node = list0 (word)

(* ****** ****** *)

extern
fun{}
doublet_get_source (): word
extern
fun{}
doublet_get_target (): word

(* ****** ****** *)

extern
fun{}
node_test (node): bool

(* ****** ****** *)

implement
{}(*tmp*)
node_test
  (nxs) =
(
  nxs.head = doublet_get_target ()
) (* end of [node_test] *)

(* ****** ****** *)

typedef wordset = set (word)

(* ****** ****** *)

implement
gcompare_val_val<strarr> = strarr_compare

(* ****** ****** *)
//
extern
fun{}
search_qlist
  (qlist(node), wordset): Option_vt(node)
//
extern
fun{}
search_qlist_add
  (!qlist(node) >> _, wordset, node): wordset
//
(* ****** ****** *)

implement
{}(*tmp*)
search_qlist
  (nxs, visited) = let
//
val isnot = qlist_isnot_nil (nxs)
//
prval () = lemma_qlist_param (nxs)
//
in
//
if
isnot
then let
//
val nx =
qlist_takeout (nxs)
//
val test = node_test (nx)
//
(*
val () =
println! ("search_qlist: nx = ", nx)
*)
//
in
//
if
test
then let
  val () =
  free (
    qlist_takeout_list (nxs)
  ) (* end of [val] *)
  val () = qlist_free_nil (nxs)
in
  Some_vt (nx)
end // end of [then]
else let
//
val visited =
search_qlist_add (nxs, visited, nx)
//
in
  search_qlist (nxs, visited)
end // end of [else]
//
end // end of [then]
else let
//
val () = qlist_free_nil (nxs)
//
in
  None_vt ((*void*))
end // end of [else]
//
end // end of [search_qlist]

(* ****** ****** *)

implement
{}(*tmp*)
search_qlist_add
  (nxs, visited, nx0) = let
//
fun loop
(
  nxs: !qlist(node) >> _
, visited: &wordset >> _, ws: List_vt(word)
) : void =
(
case+ ws of
| ~list_vt_nil () => ()
| ~list_vt_cons (w, ws) => let
    val ans = funset_is_member (visited, w)
  in
    if ans
      then loop (nxs, visited, ws)
      else let
        val _ = funset_insert (visited, w)
        val () = qlist_insert (nxs, cons0 (w, nx0))
      in
        loop (nxs, visited, ws)
      end // end of [else]
  end // end of [list_vt_cons]
)
//
var visited: wordset = visited
val ((*void*)) = loop (nxs, visited, word_get_friends (nx0.head))
//
in
  visited
end // end of [search_qlist_add]

(* ****** ****** *)

implement
doublet_search
  (src, dst) = let
//
implement
doublet_get_source<> () = src
implement
doublet_get_target<> () = dst
//
val nx0 = list0_sing (src)
//
val nxs = qlist_make_nil ()
val ((*void*)) = qlist_insert (nxs, nx0)
//
val visited = funset_make_nil ()
//
in
  search_qlist (nxs, visited)
end // end of [doublet_search]

(* ****** ****** *)

(* end of [doublet_search.dats] *)

(*
** Implementing the doublet game
*)

(* ****** ****** *)
//
#include
"share/atspre_staload.hats"
//
(* ****** ****** *)
//
staload UN =
"prelude/SATS/unsafe.sats"
//
(* ****** ****** *)
//
staload "libats/SATS/qlist.sats"
//
staload _ = "libats/DATS/qlist.dats"
//
(* ****** ****** *)
//
staload "libats/ML/SATS/basis.sats"
staload "libats/ML/SATS/list0.sats"
staload "libats/ML/SATS/strarr.sats"
//
staload _ = "libats/ML/DATS/list0.dats"
staload _ = "libats/ML/DATS/array0.dats"
staload _ = "libats/ML/DATS/strarr.dats"
//
(* ****** ****** *)
//
staload "libats/ML/SATS/funset.sats"
//
staload _ = "libats/ML/DATS/funset.dats"
staload _ = "libats/DATS/funset_avltree.dats"
//
(* ****** ****** *)

staload "./doublet.sats"

(* ****** ****** *)

typedef node = list0 (word)

(* ****** ****** *)

extern
fun{}
doublet_get_source (): word
extern
fun{}
doublet_get_target (): word

(* ****** ****** *)

extern
fun{}
node_test (node): bool

(* ****** ****** *)

implement
{}(*tmp*)
node_test
  (nxs) =
(
  nxs.head = doublet_get_target ()
) (* end of [node_test] *)

(* ****** ****** *)

typedef wordset = set (word)

(* ****** ****** *)

implement
gcompare_val<strarr> = strarr_compare

(* ****** ****** *)
//
extern
fun{}
search_qlist
  (qlist(node), wordset): Option_vt(node)
//
extern
fun{}
search_qlist_add
  (!qlist(node) >> _, wordset, node): wordset
//
(* ****** ****** *)

implement
{}(*tmp*)
search_qlist
  (nxs, visited) = let
//
val isnot = qlist_isnot_nil (nxs)
//
prval () = lemma_qlist_param (nxs)
//
in
//
if
isnot
then let
//
val nx =
qlist_takeout (nxs)
//
val test = node_test (nx)
//
(*
val () =
println! ("search_qlist: nx = ", nx)
*)
//
in
//
if
test
then let
  val () =
  free (
    qlist_takeout_list (nxs)
  ) (* end of [val] *)
  val () = qlist_free_nil (nxs)
in
  Some_vt (nx)
end // end of [then]
else let
//
val visited =
search_qlist_add (nxs, visited, nx)
//
in
  search_qlist (nxs, visited)
end // end of [else]
//
end // end of [then]
else let
//
val () = qlist_free_nil (nxs)
//
in
  None_vt ((*void*))
end // end of [else]
//
end // end of [search_qlist]

(* ****** ****** *)

implement
{}(*tmp*)
search_qlist_add
  (nxs, visited, nx0) = let
//
fun loop
(
  nxs: !qlist(node) >> _
, visited: &wordset >> _, ws: List_vt(word)
) : void =
(
case+ ws of
| ~list_vt_nil () => ()
| ~list_vt_cons (w, ws) => let
    val ans = funset_is_member (visited, w)
  in
    if ans
      then loop (nxs, visited, ws)
      else let
        val _ = funset_insert (visited, w)
        val () = qlist_insert (nxs, cons0 (w, nx0))
      in
        loop (nxs, visited, ws)
      end // end of [else]
  end // end of [list_vt_cons]
)
//
var visited: wordset = visited
val ((*void*)) = loop (nxs, visited, word_get_friends (nx0.head))
//
in
  visited
end // end of [search_qlist_add]

(* ****** ****** *)

implement
doublet_search
  (src, dst) = let
//
implement
doublet_get_source<> () = src
implement
doublet_get_target<> () = dst
//
val nx0 = list0_sing (src)
//
val nxs = qlist_make_nil ()
val ((*void*)) = qlist_insert (nxs, nx0)
//
val visited = funset_make_nil ()
//
in
  search_qlist (nxs, visited)
end // end of [doublet_search]

(* ****** ****** *)

(* end of [doublet_search.dats] *)


Updating: very very minorly

Updating: very very minorly

(*
** A simple implementation of
** Game-of-24 in ATS for use in Java
*)

(* ****** ****** *)
//
// HX: no dynloading
//
#define ATS_DYNLOADFLAG 0
//
(* ****** ****** *)
//
#include
"share/atspre_define.hats"
//
(* ****** ****** *)
//
local
#include "./../GameOf24_card.dats"
in end
local
#include "./../GameOf24_cardset.dats"
in end
local
#include "./../GameOf24_solve.dats"
in end
//
(* ****** ****** *)
//
staload
UN =
"prelude/SATS/unsafe.sats"
//
(* ****** ****** *)
//
staload
JNI = "{$JNI}/SATS/jni.sats"
//
stadef jint = $JNI.jint
stadef JNIEnvPtr = $JNI.JNIEnvPtr
stadef jstring (l:addr) = $JNI.jstring(l)
stadef jobject (l:addr) = $JNI.jobject(l)
//
(* ****** ****** *)

staload "./../GameOf24.sats"

(* ****** ****** *)
//
// HX-2013-08:
// [play24] is declared in Java class [GameOf24]
//
extern
fun
JNI_play24
  {l:addr}
(
  env: !JNIEnvPtr, obj: jobject(l)
, card1: jint, card2: jint, card3: jint, card4: jint
) : void = "ext#Java_GameOf24_play24" // endfun

(* ****** ****** *)

implement
JNI_play24
(
  env, obj, n1, n2, n3, n4
) = let
//
val n1 = $UN.cast{int}(n1)
val n2 = $UN.cast{int}(n2)
val n3 = $UN.cast{int}(n3)
val n4 = $UN.cast{int}(n4)
//
val out = stdout_ref
val res = play24 (n1, n2, n3, n4)
val ((*void*)) =
  fprintln! (out, "play24(", n1, ", ", n2, ", ", n3, ", ", n4, "):")
//
in
//
case+ res of
| list_nil() =>
  (
    fprintln! (out, "There is NO solution.")
  )
| list_cons _ =>
  (
    fpprint_cardlst (out, res); fprint_newline (out)
  )
//
end // end of [JNI_play24]

(* ****** ****** *)

%{$
//
// HX: This is ATS runtime:
//
#include "pats_ccomp_runtime.c"
#include "pats_ccomp_runtime2_dats.c"
#include "pats_ccomp_runtime_memalloc.c"
#include "pats_ccomp_runtime_trywith.c"
%}

(* ****** ****** *)

(* end of [GameOf24.dats] *)

(*
** A simple implementation of
** Game-of-24 in ATS for use in Java
*)

(* ****** ****** *)
//
// HX: no dynloading
//
#define ATS_DYNLOADFLAG 0
//
(* ****** ****** *)
//
#include
"share/atspre_define.hats"
//
(* ****** ****** *)
//
local
#include "./../GameOf24_card.dats"
in end
local
#include "./../GameOf24_cardset.dats"
in end
local
#include "./../GameOf24_solve.dats"
in end
//
(* ****** ****** *)

staload
UN =
"prelude/SATS/unsafe.sats"

(* ****** ****** *)
//
staload
JNI = "{$JNI}/SATS/jni.sats"
//
stadef jint = $JNI.jint
stadef JNIEnvPtr = $JNI.JNIEnvPtr
stadef jstring (l:addr) = $JNI.jstring(l)
stadef jobject (l:addr) = $JNI.jobject(l)
//
(* ****** ****** *)

staload "./../GameOf24.sats"

(* ****** ****** *)
//
// HX-2013-08:
// [play24] is declared in Java class [GameOf24]
//
extern
fun
JNI_play24
  {l:addr}
(
  env: !JNIEnvPtr, obj: jobject(l)
, card1: jint, card2: jint, card3: jint, card4: jint
) : void = "ext#Java_GameOf24_play24" // endfun

(* ****** ****** *)

implement
JNI_play24
(
  env, obj, n1, n2, n3, n4
) = let
//
val n1 = $UN.cast{int}(n1)
val n2 = $UN.cast{int}(n2)
val n3 = $UN.cast{int}(n3)
val n4 = $UN.cast{int}(n4)
//
val out = stdout_ref
val res = play24 (n1, n2, n3, n4)
val ((*void*)) =
  fprintln! (out, "play24(", n1, ", ", n2, ", ", n3, ", ", n4, "):")
//
in
//
case+ res of
| list_nil() =>
  (
    fprintln! (out, "There is NO solution.")
  )
| list_cons _ =>
  (
    fpprint_cardlst (out, res); fprint_newline (out)
  )
//
end // end of [JNI_play24]

(* ****** ****** *)

%{$
//
// HX: This is ATS runtime:
//
#include "pats_ccomp_runtime.c"
#include "pats_ccomp_runtime2_dats.c"
#include "pats_ccomp_runtime_memalloc.c"
#include "pats_ccomp_runtime_trywith.c"
%}

(* ****** ****** *)

(* end of [GameOf24.dats] *)


Updating: working on chardev-1

Updating: working on chardev-1

(*
** A simple char device
*)

(* ****** ****** *)
//
// HX-2014-10-24:
// nothing fancy here;
// just trying to get it working
//
(* ****** ****** *)
//
// HX-2014-10-21:
// no use for dynloading
//
#define ATS_DYNLOADFLAG 0
//
(* ****** ****** *)
//
#include
"share/atspre_define.hats"
//
#include
"{$KERNELATS}/prelude/staloadall.hats"
//
(* ****** ****** *)
//
staload
"{$LINUX}/basics.sats"
//
(* ****** ****** *)
//
staload
"{$LINUX}/SATS/errno.sats"
staload
"{$LINUX}/SATS/types.sats"
//
(* ****** ****** *)
//
staload
"{$LINUX}/SATS/init.sats"
staload
"{$LINUX}/SATS/module.sats"
staload
"{$LINUX}/SATS/kernel.sats"
staload $PRINTK // HX: opening NS
//
staload "{$LINUX}/SATS/fs.sats"
//
staload "{$LINUX}/SATS/asm/uaccess.sats"
//
(* ****** ****** *)

staload
UN = "prelude/SATS/unsafe.sats"

(* ****** ****** *)

%{^
MODULE_LICENSE("Dual BSD/GPL") ;
%} // end of [%{^]

(* ****** ****** *)

static
fun init_module(): interr = "mac#"
static
fun cleanup_module(): void = "mac#"

(* ****** ****** *)

%{^
static int Major = 0;
static int Device_open = 0;
static int Device_open_count = 0;
%} // end of [%{^]

macdef
Major = $extval(int, "Major")
macdef
Device_open = $extval(int, "Device_open")
macdef
Device_open_count = $extval(int, "Device_open_count")

(* ****** ****** *)

%{^
#define BUFLEN 80 // Max length of the message from the device
#define DEVICE_NAME "chardev-1" /* Dev name as it appears in /proc/devices */
//
typedef
char *charptr ;
char Message[BUFLEN];
charptr Message0_ptr = &Message[0];
charptr Message1_ptr = &Message[0];
//
%} // end of [%{^]

typedef charptr = $extype"charptr"

macdef
DEVICE_NAME = $extval(string, "DEVICE_NAME")
macdef
Message0_ptr = $extval(charptr, "Message0_ptr")
macdef
Message1_ptr = $extval(charptr, "Message1_ptr")

(* ****** ****** *)

%{^
//
static int device_open(struct inode *, struct file *);
static int device_release(struct inode *, struct file *);
static ssize_t device_read(struct file *, char *, size_t, loff_t *);
static ssize_t device_write(struct file *, const char *, size_t, loff_t *);
//
%} // end of [%{^]

(* ****** ****** *)

%{^

struct
file_operations
fops = {
  .read = device_read,
  .write = device_write,
  .open = device_open,
  .release = device_release
} ;

static void *fops_ptr = &(fops);

%} // end of [%{^]

macdef
fops_ptr = $extval(fops_ptr1, "fops_ptr")

(* ****** ****** *)

implement
init_module
(
) = let
//
extvar
"Major" =
register_chrdev(0u, DEVICE_NAME, fops_ptr)
//
val Major = g1ofg0(Major)
//
in
//
if
(Major > 0)
then let
//
val () =
$extfcall
(
  void
, "printk", KERN_INFO_"The assigned major number is: %d\n", Major
) (* end of [val] *)
//
in
  0(*SUCCESS*)
end // end of [then]
else let
//
val () =
$extfcall
(
  void
, "printk", KERN_ALERT_"Registering chardev failed with %d\n", Major
) (* end of [val] *)
//
in
  Major
end // end of [else]
//
end (* end of [init_module] *)

(* ****** ****** *)

implement
cleanup_module
(
// argumentless
) = () where
{
//
val
Major =
(
if Major > 0
  then g0i2u(Major) else 0u
// end of [if]
) : uint // end of [val]
//
val () = unregister_chrdev(Major, DEVICE_NAME)
//
} (* end of [cleanup_module] *)

(* ****** ****** *)
//
static
fun device_open_ (inode_ptr1, file_ptr1): interr = "mac#"
static
fun device_release_ (inode_ptr1, file_ptr1): interr = "mac#"
//
(* ****** ****** *)

implement
device_open_
  (inx, filp) = let
in
//
if
(Device_open = 0)
then let
//
extvar
"Device_open" = Device_open + 1
extvar
"Device_open_count" = Device_open_count + 1
//
val () =
$extfcall
(
  void
, "sprintf"
, Message0_ptr, "Hello(%d) from the chardev\n", Device_open_count
) : void // end of [val]
//
extvar
"Message1_ptr" = Message0_ptr
//
in
  0(*SUCCESS*)
end // end of [then]
else ~(EBUSY) // end of [else]
//
end // end of [device_open_]

(* ****** ****** *)

implement
device_release_
  (inx, filp) = let
//
extvar
"Device_open" = Device_open - 1
//
in
  0(*SUCCESS*)
end // end of [device_release_]

(* ****** ****** *)

%{$
//
static
inline
int
device_open
(
struct inode *p0, struct file *p1
) { return device_open_(p0, p1) ; }
//
static
inline
int
device_release
(
struct inode *p0, struct file *p1
) { return device_release_(p0, p1) ; }
//
%} // end of [%{$]

(* ****** ****** *)
//
static
fun
device_read_{n:int}
(
  file_ptr1, buf: &ubytes(n), size_t(n), ofs: &loff_t
) : ssize_t = "mac#" // end-of-function
static
fun
device_write_{n:int}
(
  file_ptr1, buf: &ubytes(n), size_t(n), ofs: &loff_t
) : ssize_t = "mac#" // end-of-function
//
(* ****** ****** *)

implement
device_read_
  (filp, buf, n, ofs) = let
//
val n2 =
string_nlength<>
  ($UN.cast{string}(Message1_ptr), n)
//
val
n2_ =
$extfcall
(
  size_t
, "copy_to_user", addr@buf, Message1_ptr, n2
) (* end of [val] *)
//
val nread = n2 - n2_
//
extvar
"Message1_ptr" =
add_ptr_bsz ($UN.cast{ptr}(Message1_ptr), nread)
//
in
  $UN.cast{ssize_t}(nread)
end // end of [device_read_]

(* ****** ****** *)

implement
device_write_
  (filp, buf, n, ofs) = let
//
val () =
$extfcall
(
  void
, "printk"
, KERN_ALERT_"Sorry, this operation isn't supported.\n"
) (* end of [val] *)
//
in
  $UN.cast{ssize_t}(~(EINVAL))
end // end of [device_write_]

(* ****** ****** *)

%{$
//
static
inline
ssize_t
device_read
(
struct file *p0, char *buf, size_t n, loff_t *ofs
) { return device_read_(p0, buf, n, ofs) ; }
//
static
inline
ssize_t
device_write
(
struct file *p0, const char *buf, size_t n, loff_t *ofs
) { return device_write_(p0, (void*)buf, n, ofs) ; }
//
%} // end of [%{$]

(* ****** ****** *)

(* end of [chardev-1.dats] *)

(*
** A simple char device
*)

(* ****** ****** *)
//
// HX-2014-10-24:
// nothing fancy here;
// just trying to get it working
//
(* ****** ****** *)
//
// HX-2014-10-21:
// no use for dynloading
//
#define ATS_DYNLOADFLAG 0
//
(* ****** ****** *)
//
#include
"share/atspre_define.hats"
//
#include
"{$KERNELATS}/prelude/staloadall.hats"
//
(* ****** ****** *)
//
staload
"{$LINUX}/basics.sats"
//
(* ****** ****** *)
//
staload
"{$LINUX}/SATS/errno.sats"
staload
"{$LINUX}/SATS/types.sats"
//
(* ****** ****** *)
//
staload
"{$LINUX}/SATS/init.sats"
staload
"{$LINUX}/SATS/module.sats"
staload
"{$LINUX}/SATS/kernel.sats"
staload $PRINTK // HX: opening NS
//
staload "{$LINUX}/SATS/fs.sats"
//
staload "{$LINUX}/SATS/asm/uaccess.sats"
//
(* ****** ****** *)

staload
UN = "prelude/SATS/unsafe.sats"

(* ****** ****** *)

%{^
MODULE_LICENSE("Dual BSD/GPL") ;
%} // end of [%{^]

(* ****** ****** *)

static
fun init_module(): interr = "mac#"
static
fun cleanup_module(): void = "mac#"

(* ****** ****** *)

%{^
static int Major = 0;
static int Device_open = 0;
static int Device_open_count = 0;
%} // end of [%{^]

macdef
Major = $extval(int, "Major")
macdef
Device_open = $extval(int, "Device_open")
macdef
Device_open_count = $extval(int, "Device_open_count")

(* ****** ****** *)

%{^
#define BUFLEN 80 // Max length of the message from the device
#define DEVICE_NAME "chardev-1" /* Dev name as it appears in /proc/devices */
//
typedef
char *charptr ;
char Message[BUFLEN];
charptr Message0_ptr = &Message[0];
charptr Message1_ptr = &Message[0];
//
%} // end of [%{^]

typedef charptr = $extype"charptr"

macdef
DEVICE_NAME = $extval(string, "DEVICE_NAME")
macdef
Message0_ptr = $extval(charptr, "Message0_ptr")
macdef
Message1_ptr = $extval(charptr, "Message1_ptr")

(* ****** ****** *)

%{^
//
static int device_open(struct inode *, struct file *);
static int device_release(struct inode *, struct file *);
static ssize_t device_read(struct file *, char *, size_t, loff_t *);
static ssize_t device_write(struct file *, const char *, size_t, loff_t *);
//
%} // end of [%{^]

(* ****** ****** *)

%{^

struct
file_operations
fops = {
  .read = device_read,
  .write = device_write,
  .open = device_open,
  .release = device_release
} ;

static void *fops_ptr = &(fops);

%} // end of [%{^]

macdef
fops_ptr = $extval(fops_ptr1, "fops_ptr")

(* ****** ****** *)

implement
init_module
(
) = let
//
extvar
"Major" =
register_chrdev(0u, DEVICE_NAME, fops_ptr)
//
val Major = g1ofg0(Major)
//
in
//
if
(Major > 0)
then let
//
val () =
$extfcall
(
  void
, "printk", KERN_INFO_"The assigned major number is: %d\n", Major
) (* end of [val] *)
//
in
  0(*SUCCESS*)
end // end of [then]
else let
//
val () =
$extfcall
(
  void
, "printk", KERN_ALERT_"Registering chardev failed with %d\n", Major
) (* end of [val] *)
//
in
  Major
end // end of [else]
//
end (* end of [init_module] *)

(* ****** ****** *)

implement
cleanup_module
(
// argumentless
) = () where
{
//
val
Major =
(
if Major > 0
  then g0i2u(Major) else 0u
// end of [if]
) : uint // end of [val]
//
val () = unregister_chrdev(Major, DEVICE_NAME)
//
} (* end of [cleanup_module] *)

(* ****** ****** *)
//
static
fun device_open_ (inode_ptr1, file_ptr1): interr = "mac#"
static
fun device_release_ (inode_ptr1, file_ptr1): interr = "mac#"
//
(* ****** ****** *)

implement
device_open_
  (inx, filp) = let
in
//
if
(Device_open = 0)
then let
//
extvar
"Device_open" = Device_open + 1
extvar
"Device_open_count" = Device_open_count + 1
//
val () =
$extfcall
(
  void
, "sprintf"
, Message0_ptr, "Hello(%d) from the chardev\n", Device_open_count
) : void // end of [val]
//
extvar
"Message1_ptr" = Message0_ptr
//
in
  0(*SUCCESS*)
end // end of [then]
else ~(EBUSY) // end of [else]
//
end // end of [device_open_]

(* ****** ****** *)

implement
device_release_
  (inx, filp) = let
//
extvar
"Device_open" = Device_open - 1
//
in
  0(*SUCCESS*)
end // end of [device_release_]

(* ****** ****** *)

%{$
//
static
inline
int
device_open
(
struct inode *p0, struct file *p1
) { return device_open_(p0, p1) ; }
//
static
inline
int
device_release
(
struct inode *p0, struct file *p1
) { return device_release_(p0, p1) ; }
//
%} // end of [%{$]

(* ****** ****** *)
//
static
fun
device_read_{n:int}
(
  file_ptr1, buf: &ubytes(n), size_t(n), ofs: &loff_t
) : ssize_t = "mac#" // end-of-function
static
fun
device_write_{n:int}
(
  file_ptr1, buf: &ubytes(n), size_t(n), ofs: &loff_t
) : ssize_t = "mac#" // end-of-function
//
(* ****** ****** *)

implement
device_read_
  (filp, buf, n, ofs) = let
//
val n2 =
string_nlength<>
  ($UN.cast{string}(Message1_ptr), n)
//
val
nread =
$extfcall
(
  size_t
, "copy_to_user", addr@buf, Message1_ptr, n2
) (* end of [val] *)
//
extvar
"Message1_ptr" =
add_ptr_bsz ($UN.cast{ptr}(Message1_ptr), nread)
//
val () =
$extfcall
(
  void, "printk", KERN_INFO_"device_read_: n2 = %ld", n2
)
val () =
$extfcall
(
  void, "printk", KERN_INFO_"device_read_: nread = %ld", nread
)
//
in
  $UN.cast{ssize_t}(nread)
end // end of [device_read_]

(* ****** ****** *)

implement
device_write_
  (filp, buf, n, ofs) = let
//
val () =
$extfcall
(
  void
, "printk"
, KERN_ALERT_"Sorry, this operation isn't supported.\n"
) (* end of [val] *)
//
in
  $UN.cast{ssize_t}(~(EINVAL))
end // end of [device_write_]

(* ****** ****** *)

%{$
//
static
inline
ssize_t
device_read
(
struct file *p0, char *buf, size_t n, loff_t *ofs
) { return device_read_(p0, buf, n, ofs) ; }
//
static
inline
ssize_t
device_write
(
struct file *p0, const char *buf, size_t n, loff_t *ofs
) { return device_write_(p0, (void*)buf, n, ofs) ; }
//
%} // end of [%{$]

(* ****** ****** *)

(* end of [chardev-1.dats] *)


Use LED13

Use LED13

#include "config.hats"
#include "{$TOP}/avr_prelude/kernel_staload.hats"

staload "{$TOP}/SATS/arduino.sats"

#define LED 13
#define BUTTON 7

implement main () = {
  fun loop () = {
    val b = digitalRead (BUTTON)
    val () = digitalWrite (LED, b)
    val () = loop ()
  }
  val () = pinMode (LED, OUTPUT)
  val () = pinMode (BUTTON, INPUT)
  val () = loop ()
}

#include "config.hats"
#include "{$TOP}/avr_prelude/kernel_staload.hats"

staload "{$TOP}/SATS/arduino.sats"

#define BUTTON 7

implement main () = {
  fun loop () = {
    val b = digitalRead (BUTTON)
    val () = digitalWrite (LED_BUILTIN, b)
    val () = loop ()
  }
  val () = pinMode (LED_BUILTIN, OUTPUT)
  val () = pinMode (BUTTON, INPUT)
  val () = loop ()
}