errno stuff and defer words wheeeee

2 files changed, 52 insertions, 8 deletions

diff --git a/readme.md b/readme.md
index 73af8a2..b41ba3a 100644
--- a/readme.md
+++ b/readme.md
@@ -149,7 +149,6 @@ fetch the 64 bit value at memory address a.
 ### `=   ( n1 n2 -- ? )`
 return true if n1 and n2 are equal.
 
-
 ### `<   ( n1 n2 -- ? )`
 return true if n1 is less than n2.
 
@@ -177,6 +176,9 @@ return true if n1 is greater than or equal to n2.
 ### `>body   ( ht -- xt )`
 yield the code field of header token.
 
+### `>defer   ( xt -- a )`
+get the xt storage address of the deferred execution token.
+
 ### `>errno   ( u -- val err )`
 transform the result of a system call into a value/error pair.
 if no error occured, err is zero and val is the result,
@@ -337,6 +339,17 @@ store the 32 bit value u into the memory address a.
 ### `decimal ( -- )`
 set current base to decimal.
 
+### `defer   ( "name" -- )`
+create a new word, the behaviour of which can be controlled with
+`defer!`, `defer@`, `is` and `action-of`.
+initially it is set to yield an error.
+
+### `defer!   ( xt1 xt2 -- )`
+set the deferred word xt2's behaviour to xt1.
+
+### `defer@   ( xt -- xt' )`
+retrieve the xt' which the deferred word xt is set to execute.
+
 ### `does>   ( -- )`
 modify the behaviour of the most recent `create`d word.
 (non-`create`d words will be corrupted.)
@@ -426,6 +439,9 @@ until it runs out.
 ### `invert   ( u -- u' )`
 invert all bytes in u.
 
+### `is   ( xt "name" -- ) IMMEDIATE`
+set the deferred word name to execute xt.
+
 ### `latest   ( -- a )`
 a variable containing the execution token of
 the most recently created word.
@@ -707,3 +723,5 @@ but it diverges in a few notable places:
 - PNO words (`<# # #>` etc.) work with single cell numbers.
     this is because this forth has no double number support.
     (128 bit integer arithmetic does not seem all that useful to me)
+- the dynamic allocation `free` word requires a length.
+    this is because munmap requires a length.
diff --git a/sanctuary.fs b/sanctuary.fs
index e198710..0199296 100644
--- a/sanctuary.fs
+++ b/sanctuary.fs
@@ -77,6 +77,21 @@ decimal
 \ todo s>z becomes s>z, s>z writes to pad (will then need to be moved below pno)
 : s>z  here -rot cmove, 0 c, ;
 
+\ DEFER {{{
+\ todo doc
+\ : defer  create ['] abort , does> @ execute ;
+\ : create  parse-name (header) latest ! ['] (create) compile, 0 , ;
+\ : does>  latest @ >body 2 + ['] (does>) over ! \ replace call loc
+\ 	( replace destination ) 11 + r> swap ! ;
+\ todo ['] abort → ['] ?defer or something (where ?defer yields an appropriate error)
+: defer  parse-name (header) latest !
+	['] (defer) compile, ['] abort , ( sic ) ;
+: >defer ( ht -- a )  13 + ;
+: defer@  >defer @ ;
+: defer!  >defer ! ;
+: is  state @ if postpone ['] postpone defer! else ' defer! then ; immediate
+\ }}}
+
 \ 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
@@ -97,7 +112,17 @@ variable private0  variable private$
 	0 private0 ! 0 private$ ! ;
 \ }}}
 
-\ MMAP {{{
+\ ERRNO {{{
+\ CONSTANTS {{{
+-11 constant EAGAIN  -12 constant ENOMEM  -13 constant EACCES
+-22 constant EINVAL  -25 constant ENOTTY
+\ }}}
+\ transform syscall result into [RESULT] IOR output,
+\ where IOR is zero on no error and negative on an error (RESULT then being 0)
+: >errno  dup 0< if 0 swap else 0 then ;
+\ }}}
+
+\ DYNAMIC ALLOCATION (MMAP) {{{
 \ MMAP CONSTANTS {{{
 hex
 \ prot
@@ -110,6 +135,13 @@ decimal
 
 : mmap  9 syscall6 ;
 : munmap  11 syscall2 ;
+
+: allocate ( u -- a e )  >r 0 -1 ( offset fd , unused here )
+	MAP_PRIVATE MAP_ANONYMOUS or ( flags )
+	PROT_READ PROT_WRITE or ( prot )
+	r> 0 ( length addr )
+	mmap >errno ;
+: free ( a u -- e )  swap munmap ;
 \ }}}
 
 \ NUMERIC OUTPUT {{{
@@ -127,12 +159,6 @@ variable hld
 : #>  drop hld @ pad$ over - ;
 \ }}}
 
-\ ERRNO {{{
-\ transform syscall result into [RESULT] IOR output,
-\ where IOR is zero on no error and negative on an error (RESULT then being 0)
-: >errno  dup 0< if 0 swap else 0 then ;
-\ }}}
-
 \ I/O {{{
 0 constant stdin
 1 constant stdout