aboutsummaryrefslogtreecommitdiff
path: root/kernel
diff options
context:
space:
mode:
Diffstat (limited to 'kernel')
-rw-r--r--kernel/kernel_prelude.hats12
-rw-r--r--kernel/main.dats12
-rw-r--r--kernel/output/print.dats15
-rw-r--r--kernel/output/writer.dats91
-rw-r--r--kernel/output/writer.sats (renamed from kernel/writer.sats)1
-rw-r--r--kernel/writer.dats95
6 files changed, 123 insertions, 103 deletions
diff --git a/kernel/kernel_prelude.hats b/kernel/kernel_prelude.hats
new file mode 100644
index 0000000..048cba1
--- /dev/null
+++ b/kernel/kernel_prelude.hats
@@ -0,0 +1,12 @@
+#ifndef PRELUDE
+#define PRELUDE 1
+
+#include "share/atspre_staload.hats"
+
+staload "kernel/output/writer.sats"
+val () = clear_screen()
+
+staload "kernel/output/print.dats"
+
+#endif
+
diff --git a/kernel/main.dats b/kernel/main.dats
index bbd201a..0a325ff 100644
--- a/kernel/main.dats
+++ b/kernel/main.dats
@@ -1,10 +1,6 @@
-#include "share/atspre_staload.hats"
-
-staload "kernel/writer.sats"
-dynload "kernel/writer.dats"
+#include "kernel/kernel_prelude.hats"
implement main0 () = (
- clear_screen();
- put_string("Hello world\n");
- put_string("GOEIENDSG\n");
- put_string("GOEIENDSG"))
+ println!("Hello World");
+ println!("Hello World");
+)
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/writer.sats b/kernel/output/writer.sats
index 65a2ea9..fd33424 100644
--- a/kernel/writer.sats
+++ b/kernel/output/writer.sats
@@ -30,3 +30,4 @@ castfn i2u8 {n: nat} (i: int n): uint8 n
fun put_string (str : string) : void
fun clear_screen() : void
+
diff --git a/kernel/writer.dats b/kernel/writer.dats
deleted file mode 100644
index 3e75a90..0000000
--- a/kernel/writer.dats
+++ /dev/null
@@ -1,95 +0,0 @@
-#include "share/atspre_staload.hats"
-
-staload "kernel/writer.sats"
-
-%{^
- #define get_buffer() ((void *) 0xB8000)
-%}
-
-extern fun get_buffer():<> buffer = "mac#"
-extern prfun eat_buffer (pf: buffer): void
-
-staload WRITER = {
- staload "kernel/writer.sats"
- 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 = @{position = 0, color_code = code_value(White,Black)} : writer
- val p_val = addr@(_val)
-
- in
-
- implement getref () = let
- extern praxi __assert{l:addr} (ptr: ptr (l)): vtakeout0 (writer@l)
- prval (pf, fpf) = __assert (p_val)
- in
- (pf, fpf | p_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) = $WRITER.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) = $WRITER.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))
-in
- !p_val.position := 0;
- loop(0,!p_val);
- !p_val.position := 0;
- let prval() = fpf(pf) in () end
-end