diff options
| -rw-r--r-- | readme.md | 78 | ||||
| -rw-r--r-- | sanctuary.fs | 60 | ||||
| -rw-r--r-- | sanctuary.s | 90 |
3 files changed, 199 insertions, 29 deletions
@@ -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 |