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
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", "device_read_: n2 = %ld", n2
)
val () =
$extfcall
(
  void, "printk", "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] *)

(*
** 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)
//
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] *)


Fix PEC

Fix PEC

#include "config.hats"
#include "{$TOP}/avr_prelude/kernel_staload.hats"
staload "{$TOP}/SATS/arduino.sats"
staload "{$TOP}/SATS/i2c.sats"
staload "{$TOP}/SATS/crc.sats"

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

macdef i8(x) = cast{int8}(,(x))
macdef u8(x) = cast{uint8}(,(x))
macdef u16(x) = cast{uint16}(,(x))

macdef
ifnerr(x, err, ec, t) =
(
if
(,(err) = ,(t)(0))
then let
  val () = ,(err) := ,(x)
in
  if ,(err) != ,(t)(0) then ,(err) := ,(t)(,(ec))
end // end of [then]
)

macdef err (z, t) = ,(t)(,(z))

fun wa (addr:uint8) : uint8 = addr << 1
fun ra (addr:uint8) : uint8 = (addr << 1) + u8(1)

implement i2c_start () = u8(i2c_start_p())
implement i2c_repeated_start () = u8(i2c_repeated_start_p())
implement i2c_write (b) = u8(i2c_write_p(b))
implement i2c_read (b) = i2c_read_p(i8(b))

implement i2c_read_byte(address: uint8): (uint8, uint8) = let
  var err: uint8 =                       err (0, u8)
  val () = ifnerr(i2c_start(),           err, 1, u8)
  val () = ifnerr(i2c_write(wa address), err, 2, u8)
  val b  =        i2c_read(u8(WITH_NACK))
  val () =        i2c_stop()
  in (err, b) end

implement i2c_read_byte_pec(address: uint8): (uint8, uint8) = let
  var err: uint8 =                         err (0, u8)
  val ()   = ifnerr(i2c_start(),           err, 1, u8)
  val ()   = ifnerr(i2c_write(wa address), err, 2, u8)
  val b    =        i2c_read(u8(WITH_ACK))
  val pec  =        i2c_read(u8(WITH_NACK))
  val ()   =        i2c_stop()
  val err2 = if err = u8(1) then err else if pec = pec_add(pec_add(u8(0), wa address), b) then u8(0) else u8(1)
  in (err2, b) end

implement i2c_write_byte(address: uint8, data: uint8): uint8 = let
  var err: uint8 =                       err (0, u8)
  val () = ifnerr(i2c_start(),           err, 1, u8)
  val () = ifnerr(i2c_write(wa address), err, 2, u8)
  val () = ifnerr(i2c_write(data),       err, 3, u8)
  val () =        i2c_stop()
  in err end

implement i2c_write_byte_pec(address: uint8, data: uint8): uint8 = let
  var err: uint8 =                                 err (0, u8)
  val pec = pec_add(pec_add(u8(0), wa address), data)
  val ()  = ifnerr(i2c_start(),                    err, 1, u8)
  val ()  = ifnerr(i2c_write(wa address),          err, 2, u8)
  val ()  = ifnerr(i2c_write(data),                err, 3, u8)
  val ()  = ifnerr(i2c_write(pec),                 err, 3, u8)
  val ()  =        i2c_stop()
  in err end

implement i2c_read_byte_data(address: uint8, command: uint8): (uint8, uint8) = let
  var err: uint8 =                       err (0, u8)
  val () = ifnerr(i2c_start(),           err, 1, u8)
  val () = ifnerr(i2c_write(wa address), err, 2, u8)
  val () = ifnerr(i2c_write(command),    err, 3, u8)
  val () = ifnerr(i2c_start(),           err, 4, u8)
  val () = ifnerr(i2c_write(ra address), err, 5, u8)
  val b  = if err = u8(0) then i2c_read(u8(WITH_NACK)) else u8(0)
  val () =        i2c_stop()
  in (err, b) end

implement i2c_read_byte_data_pec(address: uint8, command: uint8): (uint8, uint8) = let
  var err: uint8 =                         err (0, u8)
  val ()   = ifnerr(i2c_start(),           err, 1, u8)
  val ()   = ifnerr(i2c_write(wa address), err, 2, u8)
  val ()   = ifnerr(i2c_write(command),    err, 3, u8)
  val ()   = ifnerr(i2c_start(),           err, 4, u8)
  val ()   = ifnerr(i2c_write(ra address), err, 5, u8)
  val b    =        i2c_read(u8(WITH_ACK))
  val pec  =        i2c_read(u8(WITH_NACK))
  val ()   = i2c_stop()
  val err2 = if err = u8(1) then err else if pec = pec_add(pec_add(pec_add(pec_add(u8(0), wa address), command), ra address), b) then u8(0) else u8(1)
  in (err2, b) end

implement i2c_write_byte_data(address: uint8, command: uint8, data: uint8): uint8 = let
  var err: uint8 =                       err (0, u8)
  val () = ifnerr(i2c_start(),           err, 1, u8)
  val () = ifnerr(i2c_write(wa address), err, 2, u8)
  val () = ifnerr(i2c_write(command),    err, 3, u8)
  val () = ifnerr(i2c_write(data),       err, 4, u8)
  val () =        i2c_stop()
  in err end

implement i2c_write_byte_data_pec(address: uint8, command: uint8, data: uint8): uint8 = let
  var err: uint8 =                                                    err (0, u8)
  val pec = pec_add(pec_add(pec_add(u8(0), wa address), command), data)
  val ()  = ifnerr(i2c_start(),                                       err, 1, u8)
  val ()  = ifnerr(i2c_write(wa address),                             err, 2, u8)
  val ()  = ifnerr(i2c_write(command),                                err, 3, u8)
  val ()  = ifnerr(i2c_write(data),                                   err, 4, u8)
  val ()  = ifnerr(i2c_write(pec),                                    err, 3, u8)
  val ()  = i2c_stop()
  in err end

implement i2c_read_word_data(address: uint8, command: uint8): (uint8, uint16) = let
  var err: uint8 =                       err (0, u8)
  val () = ifnerr(i2c_start(),           err, 1, u8)
  val () = ifnerr(i2c_write(wa address), err, 2, u8)
  val () = ifnerr(i2c_write(command),    err, 3, u8)
  val () = ifnerr(i2c_start(),           err, 4, u8)
  val () = ifnerr(i2c_write(ra address), err, 5, u8)
  val b1 = if err = u8(0) then i2c_read(u8(WITH_ACK)) else u8(0)
  val b0 = if err = u8(0) then i2c_read(u8(WITH_NACK)) else u8(0)
  val () = i2c_stop()
  val w  = (u16(b0) << 8) + u16(b1)
  in (err, w) end

implement i2c_read_word_data_pec(address: uint8, command: uint8): (uint8, uint16) = let
  var err: uint8 =                         err (0, u8)
  val ()   = ifnerr(i2c_start(),           err, 1, u8)
  val ()   = ifnerr(i2c_write(wa address), err, 2, u8)
  val ()   = ifnerr(i2c_write(command),    err, 3, u8)
  val ()   = ifnerr(i2c_start(),           err, 4, u8)
  val ()   = ifnerr(i2c_write(ra address), err, 5, u8)
  val b1   =        i2c_read(u8(WITH_ACK))
  val b0   =        i2c_read(u8(WITH_ACK))
  val pec  =        i2c_read(u8(WITH_NACK))
  val ()   = i2c_stop()
  val w    = (u16(b0) << 8) + u16(b1)
  val err2 = if err = u8(1) then err else if pec = pec_add(pec_add(pec_add(pec_add(pec_add(u8(0), wa address), command), ra address), b1), b0) then u8(0) else u8(1)
  in (err2, w) end

implement i2c_write_word_data(address: uint8, command: uint8, data: uint16): uint8 = let
  var err: uint8 =                                          err (0, u8)
  val () = ifnerr(i2c_start(),                              err, 1, u8)
  val () = ifnerr(i2c_write(wa address),                    err, 2, u8)
  val () = ifnerr(i2c_write(command),                       err, 3, u8)
  val () = ifnerr(i2c_write(u8(data >> 8)),                 err, 4, u8)
  val () = ifnerr(i2c_write(u8(data - ((data >> 8) << 8))), err, 5, u8)
  val () =        i2c_stop()
  in err end

implement i2c_write_word_data_pec(address: uint8, command: uint8, data: uint16): uint8 = let
  var err: uint8 =                                                                            err (0, u8)
  val data0 = u8(data >> 8)
  val data1 = u8(data - ((data >> 8) << 8))
  val pec = pec_add(pec_add(pec_add(pec_add(u8(0), wa address), command), data0), data1)
  val ()  = ifnerr(i2c_start(),                                                               err, 1, u8)
  val ()  = ifnerr(i2c_write(wa address),                                                     err, 2, u8)
  val ()  = ifnerr(i2c_write(command),                                                        err, 3, u8)
  val ()  = ifnerr(i2c_write(data0),                                                          err, 4, u8)
  val ()  = ifnerr(i2c_write(data1),                                                          err, 5, u8)
  val ()  = ifnerr(i2c_write(pec),                                                            err, 3, u8)
  val ()  = i2c_stop()
  in err end

#include "config.hats"
#include "{$TOP}/avr_prelude/kernel_staload.hats"
staload "{$TOP}/SATS/arduino.sats"
staload "{$TOP}/SATS/i2c.sats"
staload "{$TOP}/SATS/crc.sats"

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

macdef i8(x) = cast{int8}(,(x))
macdef u8(x) = cast{uint8}(,(x))
macdef u16(x) = cast{uint16}(,(x))

macdef
ifnerr(x, err, ec, t) =
(
if
(,(err) = ,(t)(0))
then let
  val () = ,(err) := ,(x)
in
  if ,(err) != ,(t)(0) then ,(err) := ,(t)(,(ec))
end // end of [then]
)

macdef err (z, t) = ,(t)(,(z))

fun wa (addr:uint8) : uint8 = addr << 1
fun ra (addr:uint8) : uint8 = (addr << 1) + u8(1)

implement i2c_start () = u8(i2c_start_p())
implement i2c_repeated_start () = u8(i2c_repeated_start_p())
implement i2c_write (b) = u8(i2c_write_p(b))
implement i2c_read (b) = i2c_read_p(i8(b))

implement i2c_read_byte(address: uint8): (uint8, uint8) = let
  var err: uint8 =                       err (0, u8)
  val () = ifnerr(i2c_start(),           err, 1, u8)
  val () = ifnerr(i2c_write(wa address), err, 2, u8)
  val b  =        i2c_read(u8(WITH_NACK))
  val () =        i2c_stop()
  in (err, b) end

implement i2c_read_byte_pec(address: uint8): (uint8, uint8) = let
  var err: uint8 =                         err (0, u8)
  val ()   = ifnerr(i2c_start(),           err, 1, u8)
  val ()   = ifnerr(i2c_write(wa address), err, 2, u8)
  val b    =        i2c_read(u8(WITH_ACK))
  val pec  =        i2c_read(u8(WITH_NACK))
  val ()   =        i2c_stop()
  val err2 = if err = u8(1) then err else if pec = pec_add(pec_add(u8(0), address), b) then u8(0) else u8(1)
  in (err2, b) end

implement i2c_write_byte(address: uint8, data: uint8): uint8 = let
  var err: uint8 =                       err (0, u8)
  val () = ifnerr(i2c_start(),           err, 1, u8)
  val () = ifnerr(i2c_write(wa address), err, 2, u8)
  val () = ifnerr(i2c_write(data),       err, 3, u8)
  val () =        i2c_stop()
  in err end

implement i2c_write_byte_pec(address: uint8, data: uint8): uint8 = let
  var err: uint8 =                                 err (0, u8)
  val pec = pec_add(pec_add(u8(0), address), data)
  val ()  = ifnerr(i2c_start(),                    err, 1, u8)
  val ()  = ifnerr(i2c_write(wa address),          err, 2, u8)
  val ()  = ifnerr(i2c_write(data),                err, 3, u8)
  val ()  = ifnerr(i2c_write(pec),                 err, 3, u8)
  val ()  =        i2c_stop()
  in err end

implement i2c_read_byte_data(address: uint8, command: uint8): (uint8, uint8) = let
  var err: uint8 =                       err (0, u8)
  val () = ifnerr(i2c_start(),           err, 1, u8)
  val () = ifnerr(i2c_write(wa address), err, 2, u8)
  val () = ifnerr(i2c_write(command),    err, 3, u8)
  val () = ifnerr(i2c_start(),           err, 4, u8)
  val () = ifnerr(i2c_write(ra address), err, 5, u8)
  val b  = if err = u8(0) then i2c_read(u8(WITH_NACK)) else u8(0)
  val () =        i2c_stop()
  in (err, b) end

implement i2c_read_byte_data_pec(address: uint8, command: uint8): (uint8, uint8) = let
  var err: uint8 =                         err (0, u8)
  val ()   = ifnerr(i2c_start(),           err, 1, u8)
  val ()   = ifnerr(i2c_write(wa address), err, 2, u8)
  val ()   = ifnerr(i2c_write(command),    err, 3, u8)
  val ()   = ifnerr(i2c_start(),           err, 4, u8)
  val ()   = ifnerr(i2c_write(ra address), err, 5, u8)
  val b    = if err = u8(0) then i2c_read(u8(WITH_ACK)) else u8(0)
  val pec  = if err = u8(0) then i2c_read(u8(WITH_NACK)) else u8(0)
  val ()   = i2c_stop()
  val err2 = if err = u8(1) then err else if pec = pec_add(pec_add(pec_add(u8(0), address), command), b) then u8(0) else u8(1)
  in (err2, b) end

implement i2c_write_byte_data(address: uint8, command: uint8, data: uint8): uint8 = let
  var err: uint8 =                       err (0, u8)
  val () = ifnerr(i2c_start(),           err, 1, u8)
  val () = ifnerr(i2c_write(wa address), err, 2, u8)
  val () = ifnerr(i2c_write(command),    err, 3, u8)
  val () = ifnerr(i2c_write(data),       err, 4, u8)
  val () =        i2c_stop()
  in err end

implement i2c_write_byte_data_pec(address: uint8, command: uint8, data: uint8): uint8 = let
  var err: uint8 =                                                    err (0, u8)
  val pec = pec_add(pec_add(pec_add(u8(0), address), command), data)
  val ()  = ifnerr(i2c_start(),                                       err, 1, u8)
  val ()  = ifnerr(i2c_write(wa address),                             err, 2, u8)
  val ()  = ifnerr(i2c_write(command),                                err, 3, u8)
  val ()  = ifnerr(i2c_write(data),                                   err, 4, u8)
  val ()  = ifnerr(i2c_write(pec),                                    err, 3, u8)
  val ()  = i2c_stop()
  in err end

implement i2c_read_word_data(address: uint8, command: uint8): (uint8, uint16) = let
  var err: uint8 =                       err (0, u8)
  val () = ifnerr(i2c_start(),           err, 1, u8)
  val () = ifnerr(i2c_write(wa address), err, 2, u8)
  val () = ifnerr(i2c_write(command),    err, 3, u8)
  val () = ifnerr(i2c_start(),           err, 4, u8)
  val () = ifnerr(i2c_write(ra address), err, 5, u8)
  val b1 = if err = u8(0) then i2c_read(u8(WITH_ACK)) else u8(0)
  val b0 = if err = u8(0) then i2c_read(u8(WITH_NACK)) else u8(0)
  val () = i2c_stop()
  val w  = (u16(b0) << 8) + u16(b1)
  in (err, w) end

implement i2c_read_word_data_pec(address: uint8, command: uint8): (uint8, uint16) = let
  var err: uint8 =                         err (0, u8)
  val ()   = ifnerr(i2c_start(),           err, 1, u8)
  val ()   = ifnerr(i2c_write(wa address), err, 2, u8)
  val ()   = ifnerr(i2c_write(command),    err, 3, u8)
  val ()   = ifnerr(i2c_start(),           err, 4, u8)
  val ()   = ifnerr(i2c_write(ra address), err, 5, u8)
  val b1   = if err = u8(0) then i2c_read(u8(WITH_ACK)) else u8(0)
  val b0   = if err = u8(0) then i2c_read(u8(WITH_ACK)) else u8(0)
  val pec  = if err = u8(0) then i2c_read(u8(WITH_NACK)) else u8(0)
  val ()   = i2c_stop()
  val w    = (u16(b0) << 8) + u16(b1)
  val err2 = if err = u8(1) then err else if pec = pec_add(pec_add(pec_add(pec_add(u8(0), address), command), b1), b0) then u8(0) else u8(1)
  in (err2, w) end

implement i2c_write_word_data(address: uint8, command: uint8, data: uint16): uint8 = let
  var err: uint8 =                                          err (0, u8)
  val () = ifnerr(i2c_start(),                              err, 1, u8)
  val () = ifnerr(i2c_write(wa address),                    err, 2, u8)
  val () = ifnerr(i2c_write(command),                       err, 3, u8)
  val () = ifnerr(i2c_write(u8(data >> 8)),                 err, 4, u8)
  val () = ifnerr(i2c_write(u8(data - ((data >> 8) << 8))), err, 5, u8)
  val () =        i2c_stop()
  in err end

implement i2c_write_word_data_pec(address: uint8, command: uint8, data: uint16): uint8 = let
  var err: uint8 =                                                                            err (0, u8)
  val data0 = u8(data >> 8)
  val data1 = u8(data - ((data >> 8) << 8))
  val pec = pec_add(pec_add(pec_add(pec_add(u8(0), address), command), data0), data1)
  val ()  = ifnerr(i2c_start(),                                                               err, 1, u8)
  val ()  = ifnerr(i2c_write(wa address),                                                     err, 2, u8)
  val ()  = ifnerr(i2c_write(command),                                                        err, 3, u8)
  val ()  = ifnerr(i2c_write(data0),                                                          err, 4, u8)
  val ()  = ifnerr(i2c_write(data1),                                                          err, 5, u8)
  val ()  = ifnerr(i2c_write(pec),                                                            err, 3, u8)
  val ()  = i2c_stop()
  in err end


Remove unused $UN.cast

Remove unused $UN.cast

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

staload "{$TOP}/SATS/arduino.sats"
staload UN = "prelude/SATS/unsafe.sats"

#define LED 9
#define BLINK_DELAY_MS 10.0

implement main () = {
  fun loop_fadein {n:nat | n <= 255} .<255 - n>. (i: int n): void = {
    val () = analogWrite (LED, i)
    val () = delay_ms (BLINK_DELAY_MS)
    val () = if i < 255 then loop_fadein (i + 1)
  }
  fun loop_fadeout {n:nat | n <= 255} .<n>. (i: int n): void = {
    val () = analogWrite (LED, i)
    val () = delay_ms (BLINK_DELAY_MS)
    val () = if i > 0 then loop_fadeout (i - 1)
  }
  fun forever () = {
    val () = loop_fadein 0
    val () = loop_fadeout 255
    val () = forever ()
  }
  val () = pinMode (LED, OUTPUT)
  val () = forever ()
}

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

staload "{$TOP}/SATS/arduino.sats"
staload UN = "prelude/SATS/unsafe.sats"

#define LED 9
#define BLINK_DELAY_MS 10.0

implement main () = {
  fun loop_fadein {n:nat | n <= 255} .<255 - n>. (i: int n): void = {
    val () = analogWrite ($UN.cast LED, i)
    val () = delay_ms (BLINK_DELAY_MS)
    val () = if i < 255 then loop_fadein (i + 1)
  }
  fun loop_fadeout {n:nat | n <= 255} .<n>. (i: int n): void = {
    val () = analogWrite ($UN.cast LED, i)
    val () = delay_ms (BLINK_DELAY_MS)
    val () = if i > 0 then loop_fadeout (i - 1)
  }
  fun forever () = {
    val () = loop_fadein 0
    val () = loop_fadeout 255
    val () = forever ()
  }
  val () = pinMode ($UN.cast LED, OUTPUT)
  val () = forever ()
}


Updating: very minorly improving

Updating: very minorly improving

(*
** Channel pairs
*)

(* ****** ****** *)
//
staload
"./../SATS/basis.sats"
staload
"./../SATS/intset.sats"
//
staload "./basis_uchan.dats"
//
(* ****** ****** *)
//
absvtype
channel0_vtype(a:vt@ype, n:int)
//
stadef channel0 = channel0_vtype
//
extern
praxi
lemma_channel0_param
  {a:vt0p}{n:int}
  (chan0: !channel0(a, n)): [n >= 0] void
//
(* ****** ****** *)
//
extern
fun
{a:vt0p}
channel0_posneg
  {n:nat}
(
  cap: intGt(0)
, nrole: int(n), G: intset(n)
) :
(
  channel0(a, n)(*pos*), channel0(a, n)(*neg*)
) (* end of [channel0_posneg] *)
//
(* ****** ****** *)
//
extern
fun
{a:vt0p}
channel0_free
  {n:int}(chan0: channel0(a, n)): void
//
(* ****** ****** *)
//
extern
fun{a:vt0p}
channel0_send
  {n:int}
(
  !channel0(a, n)
, i: natLt(n), j: natLt(n), x: a
) : void // end-of-function
//
extern
fun{a:vt0p}
channel0_recv
  {n:int}
(
  !channel0(a, n)
, i: natLt(n), j: natLt(n), x: &a? >> a
) : void // end-of-function
extern
fun{a:vt0p}
channel0_recv_val
  {n:int}
(
  !channel0(a, n), i: natLt(n), j: natLt(n)
) : (a) // end of [channel0_recv_val]
//
(* ****** ****** *)
//
extern
fun
{a:vt0p}
channel0_link
  {n:int}
(
  cap: intGt(0)
, chan0: channel0(a, n), chan1: channel0(a, n)
) : channel0(a, n)
//
(* ****** ****** *)
//
datavtype
channel0_
(
  a:vt@ype, n:int
) =
CHANNEL0 of
(
  int(n), intset(n)
, matrixptr(uchan(a), n, n)
) (* end of [channel0_] *)
//
(* ****** ****** *)
//
assume
channel0_vtype
  (a:vt0p, n:int) = channel0_(a, n)
//
(* ****** ****** *)

implement
{a}(*tmp*)
channel0_posneg
  {n}(cap, nrole, G0) = let
//
val G1 =
  intset_ncomplement(G0, nrole)
//
val nrow = i2sz(nrole)
val ncol = i2sz(nrole)
//
vtypedef uchan = uchan(a)
//
val
u0ch = the_null_ptr
val
chmat0 =
matrixptr_make_elt<ptr>(nrow, ncol, u0ch)
val
chmat1 =
matrixptr_make_elt<ptr>(nrow, ncol, u0ch)
//
val
chmat0 =
$UN.castvwtp0{matrixptr(uchan,n,n)}(chmat0)
val
chmat1 =
$UN.castvwtp0{matrixptr(uchan,n,n)}(chmat1)
//
val p0 = ptrcast(chmat0)
and p1 = ptrcast(chmat1)
//
var
fwork =
lam@
( i: natLt(n)
, j: natLt(n)
) : void =>
{
  val n = nrole
  val chx0 = uchan_make(cap)
  and chy0 = uchan_make(cap)
  val chx1 = uchan_ref(chx0)
  and chy1 = uchan_ref(chy0)
  val ij = i * n + j and ji = j * n + i
  val () = $UN.ptr0_set_at<uchan>(p0, ij, chx0)
  val () = $UN.ptr0_set_at<uchan>(p0, ji, chy0)
  val () = $UN.ptr0_set_at<uchan>(p1, ij, chx1)
  val () = $UN.ptr0_set_at<uchan>(p1, ji, chy1)
} (* end of [fwork] *)
//
val () =
  intset2_foreach_cloref(G0, G1, $UN.cast(addr@fwork))
//
in
  (CHANNEL0(nrole, G0, chmat0), CHANNEL0(nrole, G1, chmat1))
end // end of [channel0_posneg]

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

implement
{a}(*tmp*)
channel0_free
  (chan0) = let
//
val () =
lemma_channel0_param(chan0)
//
val
~CHANNEL0(n, G, chmat) = chan0
//
implement
(elt:vtype)
matrix_uninitize$clear<elt>
  (i, j, x) = let
//
val x = $UN.castvwtp0{ptr}(x)
//
in
//
if
isneqz(x)
then (
  uchan_unref($UN.castvwtp0{uchan(a)}(x))
) (* end of [if] *)
//
end // end of [matrix_uninitize$clear]
//
val n = i2sz(n)
//
val () = matrixptr_freelin(chmat, n, n)
//
in
  // nothing
end // end of [channel0_free]

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

implement
{a}(*tmp*)
channel0_send
  (chan0, i, j, x0) =
{
//
val+CHANNEL0(n, G, chmat) = chan0
//
val p0 = ptrcast(chmat)
//
val uch =
  $UN.ptr0_get_at<uchan(a)>(p0, i*n+j)
//
val ((*void*)) = uchan_insert<a> (uch, x0)
//
val ((*returned*)) = $UN.cast2void(uch)
//
} (* end of [channel0_send] *)

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

implement
{a}(*tmp*)
channel0_recv
  (chan0, i, j, x0) = let
//
val+CHANNEL0(n, G, chmat) = chan0
//
val p0 = ptrcast(chmat)
//
val p_ij =
  ptr_add<uchan(a)>(p0, i*n+j)
//
val (pf, fpf | p_ij) =
  $UN.ptr_vtake{uchan(a)}(p_ij)
//
val () = (x0 := uchan_remove<a> (!p_ij))
//
prval ((*returned*)) = fpf(pf)
//
in
  // nothing
end // end of [channel0_recv]

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

implement
{a}(*tmp*)
channel0_recv_val
  (chan0, i, j) = x0 where
{
//
var x0: a // uninitized
//
val () = channel0_recv(chan0, i, j, x0)
//
} (* end of [channel0_recv_val] *)

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

implement
{a}(*tmp*)
channel0_link
  (cap, chan0, chan1) = let
//
prval() =
  lemma_channel0_param(chan0)
prval() =
  lemma_channel0_param(chan1)
//
fun
auxlink{n:nat}
(
  n: int(n)
, G0: intset(n), G1: intset(n), p0: ptr, p1: ptr
) : void =
{
//
vtypedef
uchan = uchan(a)
//
var
fwork =
lam@
( i: natLt(n)
, j: natLt(n)
) : void =>
{
//
  val ij = i * n + j
  val ch0_ij =
    $UN.ptr0_get_at<uchan>(p0, ij)
  val ch1_ij =
    $UN.ptr0_get_at<uchan>(p1, ij)
  val () = uchan_qinsert(ch0_ij, ch1_ij)
  val ((*freed*)) = uchan_unref(ch0_ij)
//
  val ji = j * n + i
  val ch0_ji =
    $UN.ptr0_get_at<uchan>(p0, ji)
  val ch1_ji =
    $UN.ptr0_get_at<uchan>(p1, ji)
  val () = uchan_qinsert(ch1_ji, ch0_ji)
  val ((*freed*)) = uchan_unref(ch1_ji)
//
} (* end of [fwork] *)
//
val () = intset2_foreach_cloref(G0, G1, $UN.cast(addr@fwork))
//
} (* end of [auxlink] *)
//
val+
~CHANNEL0(n0, G0, chmat0) = chan0
val+
~CHANNEL0(n1, G1, chmat1) = chan1
//
val G2 = intset_union(G0, G1) // HX: G0*G1 = 0
//
val (chan2, chan2_) = channel0_posneg(cap, n0, G2)
//
val+~CHANNEL0(_, G2_, chmat2_) = chan2_
//
val p0 = ptrcast(chmat0)
val p1 = ptrcast(chmat1)
val p2_ = ptrcast(chmat2_)
//
val () = auxlink(n0, G0, G1, p0, p1)
val () = auxlink(n0, G0, G2_, p0, p2_)
val () = auxlink(n1, G1, G2_, p1, p2_)
//
val chmat0 =
$UN.castvwtp0{matrixptr(ptr,0,0)}(chmat0)
val chmat1 =
$UN.castvwtp0{matrixptr(ptr,0,0)}(chmat1)
val chmat2_ =
$UN.castvwtp0{matrixptr(ptr,0,0)}(chmat2_)
//
val ((*freed*)) = matrixptr_free(chmat0)
val ((*freed*)) = matrixptr_free(chmat1)
val ((*freed*)) = matrixptr_free(chmat2_)
//
in
  chan2
end // end of [channel0_link]

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

(* end of [basic_channel0.dats] *)

(*
** Channel pairs
*)

(* ****** ****** *)
//
staload
"./../SATS/basis.sats"
staload
"./../SATS/intset.sats"
//
staload "./basis_uchan.dats"
//
(* ****** ****** *)
//
absvtype
channel0_vtype(a:vt@ype, n:int)
//
stadef channel0 = channel0_vtype
//
extern
praxi
lemma_channel0_param
  {a:vt0p}{n:int}
  (chan0: !channel0(a, n)): [n >= 0] void
//
(* ****** ****** *)
//
extern
fun
{a:vt0p}
channel0_posneg
  {n:nat}
(
  cap: intGt(0)
, nrole: int(n), G: intset(n)
) :
(
  channel0(a, n)(*pos*), channel0(a, n)(*neg*)
) (* end of [channel0_posneg] *)
//
(* ****** ****** *)
//
extern
fun
{a:vt0p}
channel0_free
  {n:int}(chan0: channel0(a, n)): void
//
(* ****** ****** *)
//
extern
fun{a:vt0p}
channel0_send
  {n:int}
(
  !channel0(a, n)
, i: natLt(n), j: natLt(n), x: a
) : void // end-of-function
//
extern
fun{a:vt0p}
channel0_recv
  {n:int}
(
  !channel0(a, n)
, i: natLt(n), j: natLt(n), x: &a? >> a
) : void // end-of-function
extern
fun{a:vt0p}
channel0_recv_val
  {n:int}
(
  !channel0(a, n), i: natLt(n), j: natLt(n)
) : (a) // end of [channel0_recv_val]
//
(* ****** ****** *)
//
datavtype
channel0_
(
  a:vt@ype, n:int
) =
CHANNEL0 of
(
  int(n), intset(n)
, matrixptr(uchan(a), n, n)
) (* end of [channel0_] *)
//
(* ****** ****** *)
//
assume
channel0_vtype
  (a:vt0p, n:int) = channel0_(a, n)
//
(* ****** ****** *)

implement
{a}(*tmp*)
channel0_posneg
  {n}(cap, nrole, G0) = let
//
val G1 =
  intset_ncomplement(G0, nrole)
//
val nrow = i2sz(nrole)
val ncol = i2sz(nrole)
//
vtypedef uchan = uchan(a)
//
val
elt = the_null_ptr
val
chmat0 =
matrixptr_make_elt<ptr>(nrow, ncol, elt)
val
chmat1 =
matrixptr_make_elt<ptr>(nrow, ncol, elt)
//
val
chmat0 =
$UN.castvwtp0{matrixptr(uchan,n,n)}(chmat0)
val
chmat1 =
$UN.castvwtp0{matrixptr(uchan,n,n)}(chmat1)
//
val p0 = ptrcast(chmat0)
and p1 = ptrcast(chmat1)
//
var
fwork =
lam@
( i: natLt(n)
, j: natLt(n)
) : void =>
{
  val n = nrole
  val chx0 = uchan_make(cap)
  and chy0 = uchan_make(cap)
  val chx1 = uchan_ref(chx0)
  and chy1 = uchan_ref(chy0)
  val ij = i * n + j and ji = j * n + i
  val () = $UN.ptr0_set_at<uchan>(p0, ij, chx0)
  val () = $UN.ptr0_set_at<uchan>(p0, ji, chy0)
  val () = $UN.ptr0_set_at<uchan>(p1, ij, chx1)
  val () = $UN.ptr0_set_at<uchan>(p1, ji, chy1)
} (* end of [fwork] *)
//
val () =
  intset2_foreach_cloref(G0, G1, $UN.cast(addr@fwork))
//
in
  (CHANNEL0(nrole, G0, chmat0), CHANNEL0(nrole, G1, chmat1))
end // end of [channel0_posneg]

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

implement
{a}(*tmp*)
channel0_free
  (chan0) = let
//
val () =
lemma_channel0_param(chan0)
//
val
~CHANNEL0(n, G, chmat) = chan0
//
implement
(elt:vtype)
matrix_uninitize$clear<elt>
  (i, j, x) = let
//
val x = $UN.castvwtp0{ptr}(x)
//
in
//
if
isneqz(x)
then (
  uchan_unref($UN.castvwtp0{uchan(a)}(x))
) (* end of [if] *)
//
end // end of [matrix_uninitize$clear]
//
val n = i2sz(n)
//
val () = matrixptr_freelin(chmat, n, n)
//
in
  // nothing
end // end of [channel0_free]

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

implement
{a}(*tmp*)
channel0_send
  (chan0, i, j, x0) =
{
//
val+CHANNEL0(n, G, chmat) = chan0
//
val p0 = ptrcast(chmat)
//
val uch =
  $UN.ptr0_get_at<uchan(a)>(p0, i*n+j)
//
val ((*void*)) = uchan_insert<a> (uch, x0)
//
val ((*returned*)) = $UN.cast2void(uch)
//
} (* end of [channel0_send] *)

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

implement
{a}(*tmp*)
channel0_recv
  (chan0, i, j, x0) = let
//
val+CHANNEL0(n, G, chmat) = chan0
//
val p0 = ptrcast(chmat)
//
val p_ij =
  ptr_add<uchan(a)>(p0, i*n+j)
//
val (pf, fpf | p_ij) =
  $UN.ptr_vtake{uchan(a)}(p_ij)
//
val () = (x0 := uchan_remove<a> (!p_ij))
//
prval ((*returned*)) = fpf(pf)
//
in
  // nothing
end // end of [channel0_recv]

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

implement
{a}(*tmp*)
channel0_recv_val
  (chan0, i, j) = x0 where
{
//
var x0: a // uninitized
//
val () = channel0_recv(chan0, i, j, x0)
//
} (* end of [channel0_recv_val] *)

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

(* end of [basic_channel0.dats] *)


Start to write "write" function for w5100

%{^
#include "w5100.h"
%}

#define ATS_DYNLOADFLAG 0 // no dynloading at run-time
#include "config.hats"
#include "{$TOP}/avr_prelude/kernel_staload.hats"

staload "{$TOP}/SATS/arduino.sats"
staload "{$TOP}/SATS/spi.sats"
staload "{$TOP}/SATS/ethernet_w5100.sats"
staload UN = "prelude/SATS/unsafe.sats"

macdef DDRB_PTR  = $extval(ptr, "(&DDRB)")
macdef PORTB_PTR  = $extval(ptr, "(&PORTB)")

extern fun initSS (): void = "mac#"
extern fun setSS (): void = "mac#"
extern fun resetSS (): void = "mac#"

fun _write (addr: uint16, data: uint8): void = {
  val () = setSS ()
  val _ = spi_transfer ($UN.cast 0xf0)
  val _ = spi_transfer ($UN.cast (addr >> 8))
  // xxx
  val _ = spi_transfer data
  val () = resetSS ()
}

implement ethernet_w5100_init () = {
  val () = delay_ms 300.0
  val () = spi_begin ()
  val () = initSS ()
  // xxx
}

#define ATS_DYNLOADFLAG 0 // no dynloading at run-time
#include "config.hats"
#include "{$TOP}/avr_prelude/kernel_staload.hats"

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

implement ethernet_w5100_init () = {
  val () = delay_ms 300.0
  val () = spi_begin ()
  // xxx
}


Updating: very minorly improving

Updating: very minorly improving

(*
**
** A simple GTK/CAIRO-clock
**
** Author: Hongwei Xi
** Authoremail: hwxiATcsDOTbuDOTedu
** Start Time: April, 2010
**
*)

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

(*
** Ported to ATS2 by Hongwei Xi, September, 2013
*)

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

#include "share/atspre_define.hats"
#include "share/atspre_staload.hats"

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

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

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

local
//
#define B 1
#define R 2
#define BR 3
//
val MSZ = mtrxszref_make_elt<int> (i2sz(6), i2sz(6), 0)
//
val () = MSZ[0,0] := B
val () = MSZ[0,1] := B
val () = MSZ[0,2] := B
val () = MSZ[0,3] := B
val () = MSZ[0,4] := B
val () = MSZ[0,5] := B
//
val () = MSZ[1,0] := BR
val () = MSZ[1,1] := BR
val () = MSZ[1,2] := BR
val () = MSZ[1,3] := BR
val () = MSZ[1,4] := BR
val () = MSZ[1,5] := BR
//
val () = MSZ[2,0] := 0
val () = MSZ[2,1] := 0
val () = MSZ[2,2] := BR
val () = MSZ[2,3] := BR
val () = MSZ[2,4] := 0
val () = MSZ[2,5] := 0
//
val () = MSZ[3,0] := R
val () = MSZ[3,1] := R
val () = MSZ[3,2] := BR
val () = MSZ[3,3] := BR
val () = MSZ[3,4] := R
val () = MSZ[3,5] := R
//
val () = MSZ[4,0] := R
val () = MSZ[4,1] := 0
val () = MSZ[4,2] := BR
val () = MSZ[4,3] := B
val () = MSZ[4,4] := 0
val () = MSZ[4,5] := R
//
val () = MSZ[5,0] := R
val () = MSZ[5,1] := R
val () = MSZ[5,2] := BR
val () = MSZ[5,3] := BR
val () = MSZ[5,4] := R
val () = MSZ[5,5] := R
//
in (*in-of-local*)

val the_MSZ = MSZ

end // end of [local]

(* ****** ****** *)
//
staload "{$CAIRO}/SATS/cairo.sats"
//
staload "{$LIBATSHWXI}/teaching/mydraw/SATS/mydraw.sats"
staload "{$LIBATSHWXI}/teaching/mydraw/SATS/mydraw_cairo.sats"
//
staload "{$LIBATSHWXI}/teaching/mydraw/DATS/mydraw_matgraph.dats"
//
staload _(*anon*) = "{$LIBATSHWXI}/teaching/mydraw/DATS/mydraw.dats"
staload _(*anon*) = "{$LIBATSHWXI}/teaching/mydraw/DATS/mydraw_cairo.dats"
//
(* ****** ****** *)

extern
fun
cairo_draw_mtrxszref
(
  cr: !cairo_ref1
, point, point, point, point, mtrxszref(int)
) : void // end of [cairo_draw_mtrxszref]

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

implement
cairo_draw_mtrxszref
(
  cr, p1, p2, p3, p4, MSZ
) = let
//
val p_cr = ptrcast (cr)
//
implement
mydraw_get0_cairo<> () = let
//
extern
castfn
__takeout{l:addr}(ptr(l)): vttakeout (void, cairo_ref(l))
//
in
  __takeout (p_cr)
end // end of [mydraw_get0_cairo]
//
implement
mydraw_matgraph$color<>
  (i, j) = let
  val x = MSZ[i,j]
in
//
case+ x of
| 1 => color_make (0.0, 0.0, 0.0)
| 2 => color_make (0.0, 0.0, 0.0)
| 3 => color_make (0.0, 0.0, 0.0)
| _ => color_make (1.0, 1.0, 1.0)
// end of [if]
//
end // end of [mydraw_matgraph$color]
//
val nrow = MSZ.nrow
val nrow = g1ofg0(nrow)
val () = assertloc (nrow > 0)
val nrow = sz2i (nrow)
val ncol = MSZ.ncol
val ncol = g1ofg0(ncol)
val () = assertloc (ncol > 0)
val ncol = sz2i (ncol)
//
in
  mydraw_matgraph (nrow, ncol, p1, p2, p3, p4)
end // end of [cairo_draw_matrix0]

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

extern
fun
mydraw_clock
  (cr: !cairo_ref1, width: int, height: int): void
// end of [mydraw_clock]

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

implement
mydraw_clock
  (cr, W, H) = let
//
val W =
g0int2float_int_double(W)
and H =
g0int2float_int_double(H)
//
val WH = min (W, H)
//
val xm = (W - WH) / 2
val ym = (H - WH) / 2
//
val v0 = vector_make (xm, ym)
//
val p1 = point_make (0. , 0.) + v0
val p2 = point_make (0. , WH) + v0
val p3 = point_make (WH , WH) + v0
val p4 = point_make (WH , 0.) + v0
//
val (pf | ()) = cairo_save (cr)
//
val ((*void*)) =
  cairo_draw_mtrxszref (cr, p1, p2, p3, p4, the_MSZ)
//
val ((*void*)) = cairo_restore (pf | cr)
//
in
  // nothing
end // [mydraw_clock]

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

%{^
typedef char **charptrptr ;
%} ;
abstype charptrptr = $extype"charptrptr"

(* ****** ****** *)
//
staload
"{$LIBATSHWXI}/teaching/myGTK/SATS/gtkcairoclock.sats"
staload _ =
"{$LIBATSHWXI}/teaching/myGTK/DATS/gtkcairoclock.dats"
//
(* ****** ****** *)

implement
main0 (argc, argv) =
{
//
var argc: int = argc
var argv: charptrptr = $UN.castvwtp1{charptrptr}(argv)
//
val () = $extfcall (void, "gtk_init", addr@(argc), addr@(argv))
//
implement
gtkcairoclock_title<> () = stropt_some"gtkcairoclock"
implement
gtkcairoclock_timeout_interval<> () = 500U // millisecs
implement
gtkcairoclock_mydraw<> (cr, width, height) = mydraw_clock (cr, width, height)
//
val ((*void*)) = gtkcairoclock_main ((*void*))
//
} (* end of [main0] *)

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

(* end of [myclock2.dats] *)

(*
**
** A simple GTK/CAIRO-clock
**
** Author: Hongwei Xi
** Authoremail: hwxiATcsDOTbuDOTedu
** Start Time: April, 2010
**
*)

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

(*
** Ported to ATS2 by Hongwei Xi, September, 2013
*)

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

#include "share/atspre_define.hats"
#include "share/atspre_staload.hats"

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

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

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

local
//
#define B 1
#define R 2
#define BR 3
//
val MSZ = mtrxszref_make_elt<int> (i2sz(6), i2sz(6), 0)
//
val () = MSZ[0,0] := B
val () = MSZ[0,1] := B
val () = MSZ[0,2] := B
val () = MSZ[0,3] := B
val () = MSZ[0,4] := B
val () = MSZ[0,5] := B
//
val () = MSZ[1,0] := BR
val () = MSZ[1,1] := BR
val () = MSZ[1,2] := BR
val () = MSZ[1,3] := BR
val () = MSZ[1,4] := BR
val () = MSZ[1,5] := BR
//
val () = MSZ[2,0] := 0
val () = MSZ[2,1] := 0
val () = MSZ[2,2] := BR
val () = MSZ[2,3] := BR
val () = MSZ[2,4] := 0
val () = MSZ[2,5] := 0
//
val () = MSZ[3,0] := R
val () = MSZ[3,1] := R
val () = MSZ[3,2] := BR
val () = MSZ[3,3] := BR
val () = MSZ[3,4] := R
val () = MSZ[3,5] := R
//
val () = MSZ[4,0] := R
val () = MSZ[4,1] := 0
val () = MSZ[4,2] := BR
val () = MSZ[4,3] := B
val () = MSZ[4,4] := 0
val () = MSZ[4,5] := R
//
val () = MSZ[5,0] := R
val () = MSZ[5,1] := R
val () = MSZ[5,2] := BR
val () = MSZ[5,3] := BR
val () = MSZ[5,4] := R
val () = MSZ[5,5] := R
//
in (*in-of-local*)

val the_MSZ = MSZ

end // end of [local]

(* ****** ****** *)
//
staload "{$CAIRO}/SATS/cairo.sats"
//
staload "{$LIBATSHWXI}/teaching/mydraw/SATS/mydraw.sats"
staload "{$LIBATSHWXI}/teaching/mydraw/SATS/mydraw_cairo.sats"
//
staload "{$LIBATSHWXI}/teaching/mydraw/DATS/mydraw_matgraph.dats"
//
staload _(*anon*) = "{$LIBATSHWXI}/teaching/mydraw/DATS/mydraw.dats"
staload _(*anon*) = "{$LIBATSHWXI}/teaching/mydraw/DATS/mydraw_cairo.dats"
//
(* ****** ****** *)

extern
fun
cairo_draw_mtrxszref
(
  cr: !cairo_ref1
, point, point, point, point, mtrxszref(int)
) : void // end of [cairo_draw_mtrxszref]

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

implement
cairo_draw_mtrxszref
(
  cr, p1, p2, p3, p4, MSZ
) = let
//
val p_cr = ptrcast (cr)
//
implement
mydraw_get0_cairo<> () = let
//
extern
castfn __cast {l:addr} (ptr(l)): vttakeout (void, cairo_ref(l))
//
in
  __cast (p_cr)
end // end of [mydraw_get0_cairo]
//
implement
mydraw_matgraph$color<>
  (i, j) = let
  val x = MSZ[i,j]
in
//
case+ x of
| 1 => color_make (0.0, 0.0, 0.0)
| 2 => color_make (0.0, 0.0, 0.0)
| 3 => color_make (0.0, 0.0, 0.0)
| _ => color_make (1.0, 1.0, 1.0)
// end of [if]
//
end // end of [mydraw_matgraph$color]
//
val nrow = MSZ.nrow
val nrow = g1ofg0(nrow)
val () = assertloc (nrow > 0)
val nrow = sz2i (nrow)
val ncol = MSZ.ncol
val ncol = g1ofg0(ncol)
val () = assertloc (ncol > 0)
val ncol = sz2i (ncol)
//
in
  mydraw_matgraph (nrow, ncol, p1, p2, p3, p4)
end // end of [cairo_draw_matrix0]

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

extern
fun
mydraw_clock
  (cr: !cairo_ref1, width: int, height: int): void
// end of [mydraw_clock]

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

implement
mydraw_clock
  (cr, W, H) = let
//
val W =
g0int2float_int_double(W)
and H =
g0int2float_int_double(H)
//
val WH = min (W, H)
//
val xm = (W - WH) / 2
val ym = (H - WH) / 2
//
val v0 = vector_make (xm, ym)
//
val p1 = point_make (0. , 0.) + v0
val p2 = point_make (0. , WH) + v0
val p3 = point_make (WH , WH) + v0
val p4 = point_make (WH , 0.) + v0
//
val (pf | ()) = cairo_save (cr)
//
val ((*void*)) =
  cairo_draw_mtrxszref (cr, p1, p2, p3, p4, the_MSZ)
//
val ((*void*)) = cairo_restore (pf | cr)
//
in
  // nothing
end // [mydraw_clock]

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

%{^
typedef char **charptrptr ;
%} ;
abstype charptrptr = $extype"charptrptr"

(* ****** ****** *)
//
staload
"{$LIBATSHWXI}/teaching/myGTK/SATS/gtkcairoclock.sats"
staload _ =
"{$LIBATSHWXI}/teaching/myGTK/DATS/gtkcairoclock.dats"
//
(* ****** ****** *)

implement
main0 (argc, argv) =
{
//
var argc: int = argc
var argv: charptrptr = $UN.castvwtp1{charptrptr}(argv)
//
val () = $extfcall (void, "gtk_init", addr@(argc), addr@(argv))
//
implement
gtkcairoclock_title<> () = stropt_some"gtkcairoclock"
implement
gtkcairoclock_timeout_interval<> () = 500U // millisecs
implement
gtkcairoclock_mydraw<> (cr, width, height) = mydraw_clock (cr, width, height)
//
val ((*void*)) = gtkcairoclock_main ((*void*))
//
} (* end of [main0] *)

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

(* end of [myclock2.dats] *)