\ Copyright 2021 Bradley D. Nelson 
\ 
\ Licensed under the Apache License, Version 2.0 (the "License"); 
\ you may not use this file except in compliance with the License. 
\ You may obtain a copy of the License at 
\ 
\     http://www.apache.org/licenses/LICENSE-2.0 
\ 
\ Unless required by applicable law or agreed to in writing, software 
\ distributed under the License is distributed on an "AS IS" BASIS, 
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 
\ See the License for the specific language governing permissions and 
\ limitations under the License. 
 
vocabulary posix   posix definitions 
 
( Shared Library Handling ) 
1 constant RTLD_LAZY 
2 constant RTLD_NOW 
0 z" dlopen" dlsym constant 'dlopen 
: dlopen ( z n -- a ) 'dlopen [ internals ] call2 [ posix ] ; 
create calls 
internals 
 ' call0 ,  ' call1 ,  ' call2 ,  ' call3 ,  ' call4 , 
 ' call5 ,  ' call6 ,  ' call7 ,  ' call8 ,  ' call9 , 
' call10 , ' call11 , ' call12 , ' call13 , ' call14 , ' call15 , 
posix 
: sofunc ( z n a "name" -- ) 
   swap >r swap dlsym dup 0= throw create , r> cells calls + @ , 
   does> dup @ swap cell+ @ execute ; 
: sysfunc ( z n "name" -- ) 0 sofunc ; 
: shared-library ( z "name" -- ) 
   RTLD_NOW dlopen dup 0= throw create , does> @ sofunc ; 
: sign-extend ( n -- n ) >r rp@ sl@ rdrop ; 
 
( Major Syscalls ) 
z" open" 3 sysfunc open 
z" creat" 2 sysfunc creat 
z" close" 1 sysfunc close 
z" read" 3 sysfunc read 
z" write" 3 sysfunc write 
z" lseek" 3 sysfunc lseek 
z" ftruncate" 2 sysfunc ftruncate 
z" fsync" 1 sysfunc fsync 
z" exit" 1 sysfunc sysexit 
z" fork" 0 sysfunc fork 
z" wait" 1 sysfunc wait 
z" waitpid" 3 sysfunc waitpid 
z" mmap" 6 sysfunc mmap 
z" munmap" 2 sysfunc munmap 
z" mprotect" 3 sysfunc mprotect 
z" unlink" 1 sysfunc unlink 
z" rename" 2 sysfunc rename 
z" malloc" 1 sysfunc malloc 
z" free" 1 sysfunc sysfree 
z" realloc" 2 sysfunc realloc 
z" usleep" 1 sysfunc usleep 
z" signal" 2 sysfunc signal 
 
( Directories ) 
z" chdir" 1 sysfunc chdir 
z" mkdir" 2 sysfunc mkdir 
z" rmdir" 1 sysfunc rmdir 
z" getwd" 1 sysfunc getwd 
z" opendir" 1 sysfunc opendir 
z" closedir" 1 sysfunc closedir 
z" readdir" 1 sysfunc readdir 
: .d_type ( a -- n ) 18 + c@ ; 
: .d_name ( a -- z ) 19 + ; 
 
( Errno ) 
z" __errno_location" 0 sysfunc __errno_location 
: errno ( -- n ) __errno_location sl@ ; 
 
( Default Pipes ) 
0 constant stdin 
1 constant stdout 
2 constant stderr 
 
( Seek ) 
0 constant SEEK_SET 
1 constant SEEK_CUR 
2 constant SEEK_END 
 
( mmap ) 
0 constant PROT_NONE 
1 constant PROT_READ 
2 constant PROT_WRITE 
4 constant PROT_EXEC 
$2 constant MAP_PRIVATE 
$10 constant MAP_FIXED 
$20 constant MAP_ANONYMOUS 
 
( open ) 
octal 
0 constant O_RDONLY 
1 constant O_WRONLY 
2 constant O_RDWR 
100 constant O_CREAT 
200 constant O_TRUNC 
2000 constant O_APPEND 
4000 constant O_NONBLOCK 
decimal 
 
( Hookup I/O ) 
: stdout-write ( a n -- ) stdout -rot write drop ; 
: stdin-key ( -- n ) 0 >r stdin rp@ 1 read drop r> ; 
 
also forth definitions 
: default-type stdout-write ; 
: default-key stdin-key ; 
only posix definitions 
' default-type is type 
' default-key is key 
' sysexit is terminate 
 
( I/O Error Helpers ) 
: 0( n -- ior ) 0< if errno else 0 then ; 
: 0=ior ( n -- ior ) 0= if errno else 0 then ; 
: d0( n -- n ior ) dup 0; 
: d0=ior ( n -- n ior ) dup 0=ior ; 
 
( errno.h ) 
11 constant EAGAIN 
32 constant EPIPE 
 
( Signal Handling ) 
0 constant SIG_DFL 
1 constant SIG_IGN 
 
( Signals ) 
1 constant SIGHUP 
2 constant SIGINT 
9 constant SIGKILL 
7 constant SIGBUS 
13 constant SIGPIPE 
 
( Ignore SIGPIPE ) 
SIGPIPE SIG_IGN signal drop 
 
( Modes ) 
octal 777 constant 0777 decimal 
 
( Clock ) 
z" clock_gettime" 2 sysfunc clock_gettime 
: timespec ( "name" ) create 0 , 0 , ; 
0 constant CLOCK_REALTIME 
1 constant CLOCK_MONOTONIC 
2 constant CLOCK_PROCESS_CPUTIME_ID 
3 constant CLOCK_THREAD_CPUTIME_ID 
4 constant CLOCK_MONOTONIC_RAW 
5 constant CLOCK_REALTIME_COARSE 
6 constant CLOCK_MONOTONIC_COARSE 
7 constant CLOCK_BOOTTIME 
8 constant CLOCK_REALTIME_ALARM 
9 constant CLOCK_BOOTTIME_ALARM 
 
( File control ) 
z" fcntl" 3 sysfunc fcntl 
4 constant F_SETFL 
2048 constant FNDELAY ( 04000 ) 
 
forth definitions posix 
 
( Generic Files ) 
O_RDONLY constant R/O 
O_WRONLY constant W/O 
O_RDWR constant R/W 
: BIN ( fh -- fh ) ; 
 
: CLOSE-FILE ( fh -- ior ) close 0; 
: FLUSH-FILE ( fh -- ior ) fsync 0; 
: OPEN-FILE ( a n fam -- fh ior ) >r s>z r> 0777 open sign-extend d0; 
: CREATE-FILE ( a n fam -- fh ior ) 
   >r s>z r> O_CREAT or 0777 open sign-extend d0; 
: DELETE-FILE ( a n -- ior ) s>z unlink 0; 
: RENAME-FILE ( a n a n -- ior ) s>z -rot s>z swap rename 0; 
: WRITE-FILE ( a n fh -- ior ) -rot dup >r write r> = 0=ior ; 
: READ-FILE ( a n fh -- n ior ) -rot read d0; 
: FILE-POSITION ( fh -- n ior ) 0 SEEK_CUR lseek d0; 
: REPOSITION-FILE ( n fh -- ior ) swap SEEK_SET lseek 0; 
: RESIZE-FILE ( n fh -- ior ) swap ftruncate 0; 
: FILE-SIZE ( fh -- n ior ) 
   dup 0 SEEK_CUR lseek >r 
   dup 0 SEEK_END lseek r> swap >r 
         SEEK_SET lseek drop r> d0; 
( Non-standard ) 
: NON-BLOCK ( fh -- ior ) F_SETFL FNDELAY fcntl ; 
 
( Directories ) 
: OPEN-DIR ( a n -- dh ior ) s>z opendir d0=ior ; 
: CLOSE-DIR ( dh -- ior ) closedir 0; 
: READ-DIR ( dh -- a n ) readdir dup if .d_name z>s else 0 then ; 
 
( Other Utils ) 
: ms ( n -- ) 1000 * usleep drop ; 
: ms-ticks ( -- n ) 
   0 >r 0 >r CLOCK_MONOTONIC_RAW rp@ cell - clock_gettime throw 
   r> 1000000 / r> 1000 * + ; 
 
( Shell ops ) 
: cd ( "path" -- ) bl parse s>z chdir throw ; 
: mkdir ( "path" -- ) bl parse s>z 0777 mkdir throw ; 
: rmdir ( "path" -- ) bl parse s>z rmdir throw ; 
: pwd   here getwd z>s type cr ; 
 
forth 
 
( Setup entry ) 
internals : ok   ." uEforth" raw-ok ; forth 
 

Legal: site web personnel sans commerce / personal site without seling