wheeee

3 files changed, 199 insertions, 29 deletions

diff --git a/readme.md b/readme.md
index a13df97..7b813cd 100644
--- a/readme.md
+++ b/readme.md
@@ -3,6 +3,8 @@
 sanctuary is a 64-bit subroutine threaded forth for amd64 linux systems.
 
 ## stack effect notation
+labels outside of the ones listed here are specific to a certain word's
+documentation and will be obvious or documented in the description.
 
 - `a`: memory address
 - `c`: one byte value
@@ -59,6 +61,9 @@ create a dictionary header for a word named the provided string.
 this word does not set the code field.
 this word does not update latest.
 
+### `(hide)   ( ht -- )`
+set the smudge bit on the header ht.
+
 ### `*   ( u1 u2 -- u )`
 multiply u1 and u2.
 
@@ -354,6 +359,9 @@ yields the address of the first available byte in user memory.
 ### `hex   ( -- )`
 set current base to hexadecimal.
 
+### `hide   ( "word" -- )`
+set the smudge bit on the given word.
+
 ### `hijacks   ( xt "word" -- )`
 'hijack' an existing definition to perform the action of xt.
 this word *will* corrupt the dictionary if used outside
@@ -385,6 +393,12 @@ the most recently created word.
 ### `literal   ( n -- ) IMMEDIATE COMPILE-ONLY`
 compile a push of the literal value n into the currently compiling word.
 
+### `mmap   ( offset fd flags prot u a -- u ) `
+perform a mmap(2) system call.
+
+### `munmap   ( u a -- u ) `
+perform a munmap(2) system call.
+
 ### `nip   ( u1 u2 -- u2 )`
 drop the second-highest value from the stack.
 
@@ -419,6 +433,17 @@ if the word is immediate, that will execute the word at runtime
 (like `[compile]`).
 if the word is not immediate, this will compile code that compiles that word.
 
+### `private{   ( -- )`
+mark the start of a private section closed by `}private`
+and activated with `privatise`.
+
+### `}private   ( -- )`
+mark the end of a private section opened by `private{`
+and activated with `privatise`.
+
+### `privatise   ( -- )`
+activate a private section.
+
 ### `r>   ( -- u ) ( R: u -- )`
 move a value from the return stack to the working stack.
 
@@ -448,6 +473,11 @@ converted to a null-terminated string.
 ### `smudge   ( -- )`
 toggles the smudge bit on the xt in latest.
 
+### `sp   ( -- a )`
+yield the address of the stack pointer.
+note that the address points to the stack *before*
+this value is pushed.
+
 ### `state   ( -- a )`
 a variable containing a boolean value.
 if 0 (false), the system is in interpreting mode,
@@ -456,17 +486,25 @@ if -1 (true), the system is in compiling mode.
 ### `stderr   ( -- 2 )`
 push the file descriptor of stderr to the stack.
 
-### `sp   ( -- a )`
-yield the address of the stack pointer.
-note that the address points to the stack *before*
-this value is pushed.
+### `stdin   ( -- 0 )`
+push the file descriptor of stdin to the stack.
 
 ### `stdout   ( -- 1 )`
 push the file descriptor of stdout to the stack.
 
-### `swap  ( u1 u2 -- u2 u1 )`
+### `swap   ( u1 u2 -- u2 u1 )`
 swap the two topmost values on the stack.
 
+### `sys-read   ( u a fd -- n )`
+perform a `read(2)` system call, reading into the buffer `u a`
+from file descriptor `fd`.
+n is the resulting value of the register `rax`.
+
+### `sys-write   ( u a fd -- n )`
+perform a `write(2)` system call, writing the string `u a`
+to file descriptor `fd`.
+n is the resulting value of the register `rax`.
+
 ### `syscall0   ( rax -- u )`
 perform the syscall with the id in `rax`,
 and push the value of the `rax` register to the stack.
@@ -486,6 +524,21 @@ perform the syscall with the id in `rax`,
 taking three parameters placed in `rdi`, `rsi` and `rdx`,
 and push the value of the `rax` register to the stack.
 
+### `syscall4   ( r10 rdx rsi rdi rax -- u )`
+perform the syscall with the id in `rax`,
+taking four parameters placed in `rdi`, `rsi`, `rdx` and `r10`,
+and push the value of the `rax` register to the stack.
+
+### `syscall5   ( r8 r10 rdx rsi rdi rax -- u )`
+perform the syscall with the id in `rax`,
+taking five parameters placed in `rdi`, `rsi`, `rdx`, `r10` and `r8`,
+and push the value of the `rax` register to the stack.
+
+### `syscall6   ( r9 r8 r10 rdx rsi rdi rax -- u )`
+perform the syscall with the id in `rax`,
+taking six parameters placed in `rdi`, `rsi`, `rdx`, `r10`, `r8` and `r9`,
+and push the value of the `rax` register to the stack.
+
 ### `then   ( -- ) IMMEDIATE COMPILE-ONLY`
 conclude an if statement.
 
@@ -506,6 +559,21 @@ below the second highest value on the stack.
 ### `type   ( a u -- )`
 write u characters at a to output.
 
+### `u<   ( u1 u2 -- ? )`
+return true if u1 is less than u2.
+
+### `u<=   ( u1 u2 -- ? )`
+return true if u1 is less than or equal to u2.
+
+### `u<>   ( u1 u2 -- ? )`
+return true if u1 and u2 are not equal.
+
+### `u>   ( u1 u2 -- ? )`
+return true if u1 is greater than u2.
+
+### `u>=   ( u1 u2 -- ? )`
+return true if u1 is greater than or equal to u2.
+
 ### `until   ( ? -- ) IMMEDIATE COMPILE-ONLY`
 if the given flag is true, loop back to `begin`.
 
diff --git a/sanctuary.fs b/sanctuary.fs
index c420890..15d5a0e 100644
--- a/sanctuary.fs
+++ b/sanctuary.fs
@@ -56,6 +56,14 @@
 0 constant false
 -1 constant true
 
+hex
+\ really i should just change the builtins to work with defer
+: hijacks  ' ( word ) here >r dp ! ( temporarily set dp so we can use , )
+	49 c, bb c, ( xt ) , \ mov r11, xt
+	41 c, ff c, e3 c, \ jmp r11
+	r> dp ! ;
+decimal
+
 : cmove,  dup >r  here swap cmove  r> allot ;
 : s"  [ char " ] literal parse ( a u )
 	branch >mark >r 2dup cmove, nip  ( u ) ( R: mark )
@@ -68,17 +76,51 @@
 : zstrlen  dup begin dup c@ 0<> while 1+ repeat swap - ;
 : s>z  here -rot cmove, 0 c, ;
 
-1 constant stdout
-2 constant stderr
+\ PRIVATISATION AND HIDING {{{
+\ maybe i add locals later, implementation may be complex though. this isn't.
+\ privatise just loops through words from the start of privatisation
+\ to the end and activates the smudge bit on all of them.
+\ privatisation yoinked from pforth
+
+: (hide)  cell+ dup c@ 1 or swap c! ;
+: hide  parse-name ?find (hide) ;
+
+variable private0  variable private$
 
-: type  swap stdout 1 syscall3 ;
-: emit  sp 1 swap stdout 1 syscall3 2drop ;
+: private{  latest @ private0 ! ;
+: }private  latest @ private$ ! ;
+: privatise  private0 @ 0= private$ @ 0= or if abort then
+	private$ @
+	begin dup private0 @ u> while
+	dup (hide) @ ( → next ht ) repeat drop
+	0 private0 ! 0 private$ ! ;
+\ }}}
 
+\ MMAP {{{
+\ MMAP CONSTANTS {{{
 hex
-\ really i should just change the builtins to work with defer
-: hijacks  ' ( word ) here >r dp ! ( temporarily set dp so we can use , )
-	49 c, bb c, ( xt ) , \ mov r11, xt
-	41 c, ff c, e3 c, \ jmp r11
-	r> dp ! ;
+\ prot
+0 constant PROT_NONE  1 constant PROT_READ  2 constant PROT_WRITE  4 constant PROT_EXEC
+\ flags
+1 constant MAP_SHARED  2 constant MAP_PRIVATE  3 constant MAP_SHARED_VALIDATE
+10 constant MAP_FIXED  20 constant MAP_ANONYMOUS  100 constant MAP_GROWSDOWN
 decimal
+\ }}}
+
+: mmap  9 syscall6 ;
+: munmap  11 syscall2 ;
+\ }}}
+
+\ I/O {{{
+0 constant stdin
+1 constant stdout
+2 constant stderr
+
+: sys-write  0 syscall3 ;
+: sys-read  1 syscall3 ;
+
+: type  swap stdout 1 syscall3 drop ;
+: emit  sp 1 type drop ;
+\ }}}
+
 bye
diff --git a/sanctuary.s b/sanctuary.s
index b333966..d37ca5a 100644
--- a/sanctuary.s
+++ b/sanctuary.s
@@ -253,14 +253,6 @@ defcode "parse", parse, 0
 	ret
 ; }}}
 
-defcode "type", type, 0
-	pspop rsi
-	pspop rdx
-	mov rdi, 1
-	mov rax, __NR_write
-	syscall
-	ret
-
 ; r9:  processing temporary value
 ; r10: input size
 ; r11: input addr
@@ -339,8 +331,8 @@ defcode "interpret", interpret, 0
 	jmp .loop
 
 .componly:
-	call dots
 	call abort
+	jmp .loop
 
 .intrpnum:
 	call number
@@ -350,17 +342,13 @@ defcode "interpret", interpret, 0
 	jmp .loop
 
 .compl:
-	; call dots
 	pspop r11
 	cmp r11, false
 	je .complnum
 
 	; dup immediate? if [imm] else normal then
-	; i think this is broken (; not working)
 	call dup
-	; call dots
 	call immediate_q
-	; call dots
 	pspop r13
 	cmp r13, true
 	je .callw
@@ -370,9 +358,7 @@ defcode "interpret", interpret, 0
 	jmp .loop
 
 .complnum:
-	; call dots
 	call number
-	; call dots
 	pspop r11
 	cmp r11, false
 	je .notfound
@@ -381,6 +367,7 @@ defcode "interpret", interpret, 0
 
 .notfound:
 	; error handling should go here
+	call abort
 	jmp .loop
 
 .eof:
@@ -661,6 +648,39 @@ defcode "syscall3", syscall3, 0
 	syscall
 	pspush rax
 	ret
+
+defcode "syscall4", syscall4, 0
+	pspop rax
+	pspop rdi
+	pspop rsi
+	pspop rdx
+	pspop r10
+	syscall
+	pspush rax
+	ret
+
+defcode "syscall5", syscall5, 0
+	pspop rax
+	pspop rdi
+	pspop rsi
+	pspop rdx
+	pspop r10
+	pspop r8
+	syscall
+	pspush rax
+	ret
+
+defcode "syscall6", syscall6, 0
+	pspop rax
+	pspop rdi
+	pspop rsi
+	pspop rdx
+	pspop r10
+	pspop r8
+	pspop r9
+	syscall
+	pspush rax
+	ret
 ; }}}
 
 ; stack {{{
@@ -1010,6 +1030,46 @@ defcode "0>=", zero_greatereq, 0
 	neg r11
 	pspush r11
 	ret
+
+defcode "u<", uless, 0
+	pspop r11
+	pspop r12
+	cmp r12, r11
+	setb r13b
+	movzx r11, r13b
+	neg r11
+	pspush r11
+	ret
+
+defcode "u>", ugreater, 0
+	pspop r11
+	pspop r12
+	cmp r12, r11
+	seta r13b
+	movzx r11, r13b
+	neg r11
+	pspush r11
+	ret
+
+defcode "u<=", ulesseq, 0
+	pspop r11
+	pspop r12
+	cmp r12, r11
+	setbe r13b
+	movzx r11, r13b
+	neg r11
+	pspush r11
+	ret
+
+defcode "u>=", ugreatereq, 0
+	pspop r11
+	pspop r12
+	cmp r12, r11
+	setae r13b
+	movzx r11, r13b
+	neg r11
+	pspush r11
+	ret
 ; }}}
 
 defcode "branch", branch, 0