diff options
| -rw-r--r-- | readme.md | 20 | ||||
| -rw-r--r-- | sanctuary.fs | 40 |
2 files changed, 52 insertions, 8 deletions
@@ -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 |