Overloading print + cleanup

3 files changed, 139 insertions, 0 deletions

diff --git a/kernel/output/print.dats b/kernel/output/print.dats
new file mode 100644
index 0000000..22fe575
--- /dev/null
+++ b/kernel/output/print.dats
@@ -0,0 +1,15 @@
+#include "share/atspre_staload.hats"
+
+#define ATS_DYNLOADFLAG 0
+
+staload "kernel/output/writer.sats"
+
+extern fun print_newline() : void
+implement print_newline() : void = put_string("\n")
+
+extern fun assert_errmsg(b: bool, msg: string) : void
+implement assert_errmsg(b: bool, msg: string) : void = put_string(msg)
+
+overload print with put_string of 1
+
+macdef assertloc(tf) = assert_errmsg (,(tf), $mylocation)
diff --git a/kernel/output/writer.dats b/kernel/output/writer.dats
new file mode 100644
index 0000000..c7731f6
--- /dev/null
+++ b/kernel/output/writer.dats
@@ -0,0 +1,91 @@
+#include "kernel/kernel_prelude.hats"
+
+staload "./writer.sats"
+
+#define ATS_DYNLOADFLAG 0
+
+%{^
+  #define get_buffer() ((void *) 0xB8000)
+%}
+
+extern fun get_buffer():<> buffer = "mac#"
+extern prfun eat_buffer (pf: buffer): void
+extern fun getref (): [l:addr] vtakeoutptr (writer)
+
+fun color_value(c : color): uint8 = 
+  case+ c of 
+    | Black() => i2u8 0
+    | Blue() => i2u8 1
+    | Green() => i2u8 2
+    | Cyan() => i2u8 3
+    | Red() => i2u8 4
+    | Magenta() => i2u8 5
+    | Brown() => i2u8 6
+    | LightGray() => i2u8 7
+    | DarkGray() => i2u8 8
+    | LightBlue() => i2u8 9
+    | LightGreen() => i2u8 10
+    | LightCyan() => i2u8 11
+    | LightRed() => i2u8 12
+    | Pink() => i2u8 13
+    | Yellow() => i2u8 14
+    | White() => i2u8 15
+
+fun code_value(foreground: color, background:color): uint8 = 
+  (color_value(background) << 4) lor color_value(foreground)
+
+local
+var _val: writer 
+
+in
+implement getref () = let
+  extern praxi __assert{l:addr} (ptr: ptr (l)): vtakeout0 (writer@l)
+  prval (pf, fpf) = __assert (addr@(_val))
+in
+  (pf, fpf | addr@(_val))
+end
+end
+
+fun put_char (c : char, writer: &writer) : void = let
+  val buf = get_buffer()
+  val pos = writer.position
+in
+  if (c = '\n') then
+    let 
+      val new_pos = (pos /  BUFFER_WIDTH + 1) * BUFFER_WIDTH
+    in
+      if (new_pos < N) then
+        writer.position := new_pos
+      else
+        clear_screen()
+    end
+  else (
+    buf.1->[writer.position] := @{ ascii_character = c, color_code = writer.color_code};
+
+    if (pos < N - 1) then
+      writer.position := succ(pos)
+    else
+      clear_screen());
+
+  let prval() = eat_buffer buf in () end
+end
+
+
+implement put_string (str : string) : void = let
+  val (pf, fpf | p_val) = getref()
+  implement string_foreach$fwork<writer> (c,env) = put_char(c,env)
+  val _ =  string_foreach_env<writer> (g1ofg0(str),!p_val)
+  prval() = fpf(pf)
+in  
+end
+
+implement clear_screen() : void = let
+  val (pf, fpf | p_val) = getref()
+  fun loop {n : nat | n < N - 1} .<N-n>. (i : int n, wr : &writer) : void = 
+    (put_char('\0', wr); if (i < N - 2) then loop(i+1,wr))
+  val () = !p_val := @{position = 0, color_code = code_value(White,Black)}
+in
+  loop(0,!p_val);
+  !p_val.position := 0;
+  let prval() = fpf(pf) in () end
+end
diff --git a/kernel/output/writer.sats b/kernel/output/writer.sats
new file mode 100644
index 0000000..fd33424
--- /dev/null
+++ b/kernel/output/writer.sats
@@ -0,0 +1,33 @@
+#define BUFFER_HEIGHT 23
+#define BUFFER_WIDTH 80
+#define N BUFFER_HEIGHT * BUFFER_WIDTH
+
+datatype color =
+  | Black 
+  | Blue 
+  | Green 
+  | Cyan 
+  | Red 
+  | Magenta 
+  | Brown 
+  | LightGray 
+  | DarkGray 
+  | LightBlue 
+  | LightGreen 
+  | LightCyan 
+  | LightRed 
+  | Pink 
+  | Yellow 
+  | White 
+
+
+typedef screenChar = @{ ascii_character = char, color_code = uint8}
+
+vtypedef buffer = [l : agz] (@[screenChar][N] @ l | ptr l)
+typedef writer  = @{position = [a:int | a >= 0 && a < N] int (a), color_code = uint8}
+
+castfn i2u8 {n: nat} (i: int n): uint8 n
+
+fun put_string (str : string) : void
+fun clear_screen() : void
+