diff options
Diffstat (limited to 'kernel')
-rw-r--r-- | kernel/kernel_prelude.hats | 12 | ||||
-rw-r--r-- | kernel/main.dats | 12 | ||||
-rw-r--r-- | kernel/output/print.dats | 15 | ||||
-rw-r--r-- | kernel/output/writer.dats | 91 | ||||
-rw-r--r-- | kernel/output/writer.sats (renamed from kernel/writer.sats) | 1 | ||||
-rw-r--r-- | kernel/writer.dats | 95 |
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 |