├── .github └── workflows │ └── build.yml ├── .gitignore ├── LICENCE ├── Makefile ├── README.md ├── examples ├── dirent │ └── dirent.f90 ├── fifo │ └── fifo.f90 ├── fork │ └── fork.f90 ├── irc │ └── irc.f90 ├── key │ └── key.f90 ├── mqueue │ └── mqueue.f90 ├── msg │ └── msg.f90 ├── mutex │ └── mutex.f90 ├── os │ └── os.F90 ├── pid │ └── pid.f90 ├── pipe │ └── pipe.f90 ├── pthread │ └── pthread.f90 ├── regex │ └── regex.f90 ├── semaphore │ └── semaphore.f90 ├── serial │ └── serial.f90 ├── signal │ └── signal.f90 ├── socket │ └── socket.f90 ├── stat │ └── stat.f90 ├── time │ └── time.f90 ├── uname │ └── uname.f90 └── uptime │ └── uptime.f90 ├── ford.md ├── fpm.toml └── src ├── unix.f90 ├── unix_dirent.F90 ├── unix_errno.F90 ├── unix_fcntl.F90 ├── unix_inet.F90 ├── unix_ioctl.F90 ├── unix_ipc.F90 ├── unix_macro.c ├── unix_mqueue.F90 ├── unix_msg.F90 ├── unix_netdb.F90 ├── unix_pthread.F90 ├── unix_regex.F90 ├── unix_semaphore.F90 ├── unix_signal.F90 ├── unix_socket.F90 ├── unix_stat.F90 ├── unix_stdio.F90 ├── unix_stdlib.F90 ├── unix_string.F90 ├── unix_syslog.F90 ├── unix_termios.F90 ├── unix_time.F90 ├── unix_types.F90 ├── unix_unistd.F90 ├── unix_utsname.F90 └── unix_wait.F90 /.github/workflows/build.yml: -------------------------------------------------------------------------------- 1 | name: Build 2 | 3 | on: 4 | push: 5 | branches: [ master ] 6 | pull_request: 7 | branches: [ master ] 8 | 9 | jobs: 10 | build-and-test: 11 | runs-on: ${{ matrix.os }} 12 | strategy: 13 | matrix: 14 | os: [ ubuntu-24.04 ] 15 | env: 16 | GCC_V: 14 17 | 18 | steps: 19 | - name: Checkout Source Code 20 | uses: actions/checkout@v3 21 | 22 | - name: Install Dependencies (Linux) 23 | if: contains(matrix.os, 'ubuntu') 24 | run: | 25 | sudo apt-get update 26 | sudo apt-get install -y gcc-${GCC_V} gfortran-${GCC_V} make 27 | sudo update-alternatives --install /usr/bin/gcc gcc /usr/bin/gcc-${GCC_V} 100 \ 28 | --slave /usr/bin/gfortran gfortran /usr/bin/gfortran-${GCC_V} 29 | 30 | - name: Build and Test (Linux) 31 | if: contains(matrix.os, 'ubuntu') 32 | run: | 33 | which gfortran 34 | gfortran --version 35 | which gcc 36 | gcc --version 37 | make linux 38 | make linux_examples 39 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Distribution / packaging 2 | .xmake/ 3 | env/ 4 | build/ 5 | dist/ 6 | var/ 7 | 8 | # Other stuff 9 | *.swp 10 | *.mod 11 | *.o 12 | *.a 13 | *.so 14 | -------------------------------------------------------------------------------- /LICENCE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2020, Philipp Engel 2 | 3 | Permission to use, copy, modify, and/or distribute this software for any purpose 4 | with or without fee is hereby granted, provided that the above copyright notice 5 | and this permission notice appear in all copies. 6 | 7 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH 8 | REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND 9 | FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, 10 | INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS 11 | OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER 12 | TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF 13 | THIS SOFTWARE. 14 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .POSIX: 2 | .SUFFIXES: 3 | 4 | # Parameters: 5 | # 6 | # OS - Set to either `FreeBSD` or `linux`: 7 | # PREFIX - Change to `/usr` on Linux. 8 | # FC - Fortran compiler. 9 | # CC - C compiler. 10 | # AR - Archiver. 11 | # MAKE - Make tool. 12 | # FORD - FORD documentation generator. 13 | # FFLAGS - Fortran compiler flags. 14 | # CFLAGS - C compiler flags. 15 | # PPFLAGS - Pre-processor flags. Change to `-fpp` for Intel IFORT. 16 | # ARFLAGS - Archiver flags. 17 | # LDFLAGS - Linker flags. 18 | # LDLIBS - Linker libraries. 19 | # TARGET - Output library name. # 20 | # 21 | OS = FreeBSD 22 | PREFIX = /usr/local 23 | FC = gfortran 24 | CC = gcc 25 | AR = ar 26 | MAKE = make 27 | FORD = ford 28 | 29 | DEBUG = -g -O0 -Wall -fmax-errors=1 30 | RELEASE = -O2 -march=native 31 | 32 | FFLAGS = $(RELEASE) 33 | CFLAGS = $(RELEASE) 34 | PPFLAGS = -cpp -D__$(OS)__ 35 | ARFLAGS = rcs 36 | LDFLAGS = -I$(PREFIX)/include -L$(PREFIX)/lib 37 | LDLIBS = 38 | INCDIR = $(PREFIX)/include/libfortran-unix 39 | LIBDIR = $(PREFIX)/lib 40 | DOCDIR = ./doc 41 | 42 | TARGET = libfortran-unix.a 43 | 44 | SRC = src/unix.f90 src/unix_dirent.F90 src/unix_errno.F90 src/unix_fcntl.F90 \ 45 | src/unix_inet.F90 src/unix_ioctl.F90 src/unix_ipc.F90 src/unix_mqueue.F90 \ 46 | src/unix_msg.F90 src/unix_netdb.F90 src/unix_pthread.F90 \ 47 | src/unix_regex.F90 src/unix_semaphore.F90 src/unix_signal.F90 \ 48 | src/unix_socket.F90 src/unix_stat.F90 src/unix_stdio.F90 \ 49 | src/unix_stdlib.F90 src/unix_string.F90 src/unix_syslog.F90 \ 50 | src/unix_termios.F90 src/unix_time.F90 src/unix_types.F90 \ 51 | src/unix_unistd.F90 src/unix_utsname.F90 src/unix_wait.F90 52 | 53 | OBJ = unix.o unix_dirent.o unix_errno.o unix_fcntl.o \ 54 | unix_inet.o unix_ioctl.o unix_ipc.o unix_mqueue.o unix_msg.o \ 55 | unix_netdb.o unix_pthread.o unix_regex.o unix_semaphore.o \ 56 | unix_signal.o unix_socket.o unix_stat.o unix_stdio.o \ 57 | unix_stdlib.o unix_string.o unix_syslog.o unix_termios.o \ 58 | unix_time.o unix_types.o unix_unistd.o unix_utsname.o \ 59 | unix_wait.o unix_macro.o 60 | 61 | .PHONY: all clean doc examples install \ 62 | freebsd freebsd_doc freebsd_examples \ 63 | linux linux_aarch64 linux_doc linux_examples 64 | 65 | all: $(TARGET) 66 | 67 | # Library 68 | $(TARGET): $(SRC) 69 | $(CC) $(CFLAGS) -c src/unix_macro.c 70 | $(FC) $(FFLAGS) $(PPFLAGS) -c src/unix_types.F90 71 | $(FC) $(FFLAGS) $(PPFLAGS) -c src/unix_dirent.F90 72 | $(FC) $(FFLAGS) $(PPFLAGS) -c src/unix_errno.F90 73 | $(FC) $(FFLAGS) $(PPFLAGS) -c src/unix_fcntl.F90 74 | $(FC) $(FFLAGS) $(PPFLAGS) -c src/unix_inet.F90 75 | $(FC) $(FFLAGS) $(PPFLAGS) -c src/unix_ioctl.F90 76 | $(FC) $(FFLAGS) $(PPFLAGS) -c src/unix_ipc.F90 77 | $(FC) $(FFLAGS) $(PPFLAGS) -c src/unix_time.F90 78 | $(FC) $(FFLAGS) $(PPFLAGS) -c src/unix_mqueue.F90 79 | $(FC) $(FFLAGS) $(PPFLAGS) -c src/unix_msg.F90 80 | $(FC) $(FFLAGS) $(PPFLAGS) -c src/unix_netdb.F90 81 | $(FC) $(FFLAGS) $(PPFLAGS) -c src/unix_pthread.F90 82 | $(FC) $(FFLAGS) $(PPFLAGS) -c src/unix_regex.F90 83 | $(FC) $(FFLAGS) $(PPFLAGS) -c src/unix_semaphore.F90 84 | $(FC) $(FFLAGS) $(PPFLAGS) -c src/unix_signal.F90 85 | $(FC) $(FFLAGS) $(PPFLAGS) -c src/unix_socket.F90 86 | $(FC) $(FFLAGS) $(PPFLAGS) -c src/unix_stat.F90 87 | $(FC) $(FFLAGS) $(PPFLAGS) -c src/unix_stdio.F90 88 | $(FC) $(FFLAGS) $(PPFLAGS) -c src/unix_stdlib.F90 89 | $(FC) $(FFLAGS) $(PPFLAGS) -c src/unix_string.F90 90 | $(FC) $(FFLAGS) $(PPFLAGS) -c src/unix_syslog.F90 91 | $(FC) $(FFLAGS) $(PPFLAGS) -c src/unix_termios.F90 92 | $(FC) $(FFLAGS) $(PPFLAGS) -c src/unix_unistd.F90 93 | $(FC) $(FFLAGS) $(PPFLAGS) -c src/unix_utsname.F90 94 | $(FC) $(FFLAGS) $(PPFLAGS) -c src/unix_wait.F90 95 | $(FC) $(FFLAGS) $(PPFLAGS) -c src/unix.f90 96 | $(AR) $(ARFLAGS) $(TARGET) $(OBJ) 97 | 98 | freebsd: 99 | $(MAKE) $(TARGET) OS=FreeBSD 100 | 101 | linux: 102 | $(MAKE) $(TARGET) OS=linux 103 | 104 | linux_aarch64: 105 | $(MAKE) $(TARGET) PPFLAGS="-cpp -D__linux__ -D__aarch64__" 106 | 107 | freebsd_examples: 108 | $(MAKE) examples OS=FreeBSD 109 | 110 | linux_examples: 111 | $(MAKE) examples OS=linux 112 | 113 | # Examples 114 | examples: dirent fifo fork irc key mqueue mutex msg os pid pipe pthread regex \ 115 | semaphore serial signal socket stat time uname uptime 116 | 117 | dirent: $(TARGET) examples/dirent/dirent.f90 118 | $(FC) $(FFLAGS) $(PPFLAGS) $(LDFLAGS) -o dirent examples/dirent/dirent.f90 $(TARGET) $(LDLIBS) 119 | 120 | fifo: $(TARGET) examples/fifo/fifo.f90 121 | $(FC) $(FFLAGS) $(PPFLAGS) $(LDFLAGS) -o fifo examples/fifo/fifo.f90 $(TARGET) $(LDLIBS) 122 | 123 | fork: $(TARGET) examples/fork/fork.f90 124 | $(FC) $(FFLAGS) $(PPFLAGS) $(LDFLAGS) -o fork examples/fork/fork.f90 $(TARGET) $(LDLIBS) 125 | 126 | irc: $(TARGET) examples/irc/irc.f90 127 | $(FC) $(FFLAGS) $(PPFLAGS) $(LDFLAGS) -o irc examples/irc/irc.f90 $(TARGET) $(LDLIBS) 128 | 129 | key: $(TARGET) examples/key/key.f90 130 | $(FC) $(FFLAGS) $(PPFLAGS) $(LDFLAGS) -o key examples/key/key.f90 $(TARGET) $(LDLIBS) 131 | 132 | mqueue: $(TARGET) examples/mqueue/mqueue.f90 133 | $(FC) $(FFLAGS) $(PPFLAGS) $(LDFLAGS) -o mqueue examples/mqueue/mqueue.f90 $(TARGET) $(LDLIBS) -lrt 134 | 135 | msg: $(TARGET) examples/msg/msg.f90 136 | $(FC) $(FFLAGS) $(PPFLAGS) $(LDFLAGS) -o msg examples/msg/msg.f90 $(TARGET) $(LDLIBS) 137 | 138 | mutex: $(TARGET) examples/mutex/mutex.f90 139 | $(FC) $(FFLAGS) $(PPFLAGS) $(LDFLAGS) -o mutex examples/mutex/mutex.f90 $(TARGET) $(LDLIBS) -lpthread 140 | 141 | os: $(TARGET) examples/os/os.F90 142 | $(FC) $(FFLAGS) $(PPFLAGS) $(LDFLAGS) -o os examples/os/os.F90 $(TARGET) $(LDLIBS) 143 | 144 | pid: $(TARGET) examples/pid/pid.f90 145 | $(FC) $(FFLAGS) $(PPFLAGS) $(LDFLAGS) -o pid examples/pid/pid.f90 $(TARGET) $(LDLIBS) 146 | 147 | pipe: $(TARGET) examples/pipe/pipe.f90 148 | $(FC) $(FFLAGS) $(PPFLAGS) $(LDFLAGS) -o pipe examples/pipe/pipe.f90 $(TARGET) $(LDLIBS) 149 | 150 | pthread: $(TARGET) examples/pthread/pthread.f90 151 | $(FC) $(FFLAGS) $(PPFLAGS) $(LDFLAGS) -o pthread examples/pthread/pthread.f90 $(TARGET) $(LDLIBS) -lpthread 152 | 153 | regex: $(TARGET) examples/regex/regex.f90 154 | $(FC) $(FFLAGS) $(PPFLAGS) $(LDFLAGS) -o regex examples/regex/regex.f90 $(TARGET) $(LDLIBS) 155 | 156 | semaphore: $(TARGET) examples/semaphore/semaphore.f90 157 | $(FC) $(FFLAGS) $(PPFLAGS) $(LDFLAGS) -o semaphore examples/semaphore/semaphore.f90 $(TARGET) $(LDLIBS) -lpthread 158 | 159 | serial: $(TARGET) examples/serial/serial.f90 160 | $(FC) $(FFLAGS) $(PPFLAGS) $(LDFLAGS) -o serial examples/serial/serial.f90 $(TARGET) $(LDLIBS) 161 | 162 | signal: $(TARGET) examples/signal/signal.f90 163 | $(FC) $(FFLAGS) $(PPFLAGS) $(LDFLAGS) -o signal examples/signal/signal.f90 $(TARGET) $(LDLIBS) 164 | 165 | socket: $(TARGET) examples/socket/socket.f90 166 | $(FC) $(FFLAGS) $(PPFLAGS) $(LDFLAGS) -o socket examples/socket/socket.f90 $(TARGET) $(LDLIBS) 167 | 168 | stat: $(TARGET) examples/stat/stat.f90 169 | $(FC) $(FFLAGS) $(PPFLAGS) $(LDFLAGS) -o stat examples/stat/stat.f90 $(TARGET) $(LDLIBS) 170 | 171 | time: $(TARGET) examples/time/time.f90 172 | $(FC) $(FFLAGS) $(PPFLAGS) $(LDFLAGS) -o time examples/time/time.f90 $(TARGET) $(LDLIBS) 173 | 174 | uname: $(TARGET) examples/uname/uname.f90 175 | $(FC) $(FFLAGS) $(PPFLAGS) $(LDFLAGS) -o uname examples/uname/uname.f90 $(TARGET) $(LDLIBS) 176 | 177 | uptime: $(TARGET) examples/uptime/uptime.f90 178 | $(FC) $(FFLAGS) $(PPFLAGS) $(LDFLAGS) -o uptime examples/uptime/uptime.f90 $(TARGET) $(LDLIBS) 179 | 180 | # Documentation 181 | doc: ford.md 182 | $(FORD) -d ./src ford.md 183 | 184 | freebsd_doc: ford.md 185 | $(FORD) -m "__FreeBSD__" -d ./src ford.md 186 | 187 | linux_doc: ford.md 188 | $(FORD) -m "__linux__" -d ./src ford.md 189 | 190 | # Installation. 191 | install: $(TARGET) 192 | @echo "--- Installing $(TARGET) to $(LIBDIR)/ ..." 193 | install -d $(LIBDIR) 194 | install -m 644 $(TARGET) $(LIBDIR)/ 195 | @echo "--- Installing module files to $(INCDIR)/ ..." 196 | install -d $(INCDIR) 197 | install -m 644 unix*.mod $(INCDIR)/ 198 | 199 | # Clean-up. 200 | clean: 201 | if [ `ls -1 *.mod 2>/dev/null | wc -l` -gt 0 ]; then rm *.mod; fi 202 | if [ `ls -1 *.o 2>/dev/null | wc -l` -gt 0 ]; then rm *.o; fi 203 | if [ -e $(DOCDIR) ]; then rm -r $(DOCDIR); fi 204 | if [ -e $(TARGET) ]; then rm $(TARGET); fi 205 | if [ -e dirent ]; then rm dirent; fi 206 | if [ -e fifo ]; then rm fifo; fi 207 | if [ -e fork ]; then rm fork; fi 208 | if [ -e irc ]; then rm irc; fi 209 | if [ -e key ]; then rm key; fi 210 | if [ -e mqueue ]; then rm mqueue; fi 211 | if [ -e msg ]; then rm msg; fi 212 | if [ -e mutex ]; then rm mutex; fi 213 | if [ -e os ]; then rm os; fi 214 | if [ -e pid ]; then rm pid; fi 215 | if [ -e pipe ]; then rm pipe; fi 216 | if [ -e pthread ]; then rm pthread; fi 217 | if [ -e regex ]; then rm regex; fi 218 | if [ -e semaphore ]; then rm semaphore; fi 219 | if [ -e serial ]; then rm serial; fi 220 | if [ -e signal ]; then rm signal; fi 221 | if [ -e socket ]; then rm socket; fi 222 | if [ -e stat ]; then rm stat; fi 223 | if [ -e time ]; then rm time; fi 224 | if [ -e uname ]; then rm uname; fi 225 | if [ -e uptime ]; then rm uptime; fi 226 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # fortran-unix 2 | 3 | ![Language](https://img.shields.io/badge/-Fortran-734f96?logo=fortran&logoColor=white) 4 | ![License](https://img.shields.io/github/license/dabamos/dmpack?color=blue) 5 | ![Build](https://github.com/interkosmos/fortran-unix/actions/workflows/build.yml/badge.svg) 6 | 7 | A work-in-progress collection of Fortran 2008 ISO C binding interfaces to 8 | selected POSIX and SysV types, functions, and routines on 64-bit Unix-like 9 | operating systems: 10 | 11 | * standard input/output, 12 | * file and directory access, 13 | * clocks and timers, 14 | * signals, 15 | * processes, 16 | * pipes, 17 | * serial port input/output, 18 | * terminal control, 19 | * POSIX threads, 20 | * POSIX mutexes and semaphores, 21 | * POSIX regular expressions, 22 | * BSD sockets, 23 | * UNIX System V message queues, 24 | * POSIX message queues. 25 | 26 | Similar libraries for modern Fortran: 27 | 28 | * [M_process](https://github.com/urbanjost/M_process), 29 | * [M_system](https://github.com/urbanjost/M_system), 30 | * [forthreads](https://github.com/ohm314/forthreads), 31 | * [fortran-server](https://github.com/lukeasrodgers/fortran-server), 32 | * [fortranposix](https://sourceforge.net/projects/fortranposix/), 33 | * [fortyxima](https://bitbucket.org/aradi/fortyxima/), 34 | * [fsockets](https://github.com/trifling/fsocket), 35 | * [posix90](http://savannah.nongnu.org/projects/posix90/). 36 | 37 | Currently, only Linux (glibc) and FreeBSD are supported. The library has been 38 | tested on: 39 | 40 | * FreeBSD 14 (GCC 14, LLVM 20), 41 | * Debian 12 (GCC 12, Intel oneAPI 2024). 42 | 43 | Preprocessor macros are used to achieve platform-independent interoperability. 44 | Therefore, your Fortran compiler has to support at least GNU preprocessor 45 | conditionals. 46 | 47 | ## Build Instructions 48 | 49 | Run either GNU/BSD make or [FPM](https://github.com/fortran-lang/fpm) to build 50 | the static library `libfortran-unix.a`. Link your Fortran application with 51 | `libfortran-unix.a`, and optionally with `-lpthread` to access POSIX threads, or 52 | `-lrt` to access POSIX message queues. 53 | 54 | ### Make 55 | 56 | On FreeBSD, run: 57 | 58 | ``` 59 | $ make freebsd 60 | ``` 61 | 62 | To build with LLVM 20 instead: 63 | 64 | ``` 65 | $ make freebsd CC=clang20 FC=flang20 66 | ``` 67 | 68 | On Linux (x86-64), run: 69 | 70 | ``` 71 | $ make linux 72 | ``` 73 | 74 | On Linux (aarch64), run: 75 | 76 | ``` 77 | $ make linux_aarch64 78 | ``` 79 | 80 | To build with Intel oneAPI, run: 81 | 82 | ``` 83 | $ make CC=icx FC=ifx PPFLAGS= 84 | ``` 85 | 86 | Optionally, install `libfortran-unix.a` and the associated module files 87 | system-wide: 88 | 89 | ``` 90 | $ make install PREFIX=/opt 91 | --- Installing libfortran-unix.a to /opt/lib/ ... 92 | --- Installing module files to /opt/include/libfortran-unix/ ... 93 | ``` 94 | 95 | ### Fortran Package Manager 96 | 97 | Using FPM, a preprocessor flag has to be passed to GNU Fortran. On FreeBSD: 98 | 99 | ``` 100 | $ fpm build --profile release --flag "-D__FreeBSD__" 101 | ``` 102 | 103 | On Linux (x86-64): 104 | 105 | ``` 106 | $ fpm build --profile release --flag "-D__linux__" 107 | ``` 108 | 109 | On Linux (aarch64): 110 | 111 | ``` 112 | $ fpm build --profile release --flag "-D__linux__ -D__aarch64__" 113 | ``` 114 | 115 | ## Source Code Documentation 116 | 117 | The source code documentation of the library has to be created with 118 | [FORD](https://github.com/Fortran-FOSS-Programmers/ford). Install the Python 119 | package with: 120 | 121 | ``` 122 | $ python3 -m pip install -U ford 123 | ``` 124 | 125 | In the source repository, either run: 126 | 127 | ``` 128 | $ make freebsd_doc 129 | ``` 130 | 131 | Or: 132 | 133 | ``` 134 | $ make linux_doc 135 | ``` 136 | 137 | The HTML files will be written to directory `doc/`. Open `index.html` in a web 138 | browser. 139 | 140 | ## Examples 141 | 142 | Examples are provided in directory `examples/`: 143 | 144 | * **dirent** prints the contents of a file system directory. 145 | * **fifo** creates a named pipe for IPC. 146 | * **fork** forks a process and uses anonymous pipes for IPC. 147 | * **irc** implements a basic IRC bot, based on BSD sockets. 148 | * **key** reads single key-strokes from standard input. 149 | * **mqueue** creates a POSIX message queue. 150 | * **msg** shows message passing with UNIX System V message queues. 151 | * **mutex** demonstrates threaded access to variable using a mutex. 152 | * **os** returns the name of the operating system (Linux, macOS, FreeBSD, ...). 153 | * **pid** outputs the process id. 154 | * **pipe** creates anonymous pipes for bidirectional IPC. 155 | * **pthread** runs a Fortran subroutine inside multiple POSIX threads. 156 | * **regex** calls POSIX regex functions. 157 | * **semaphore** tests POSIX semaphores. 158 | * **serial** shows some basic serial port input reading (requires *socat(1)* and *minicom(1)*). 159 | * **signal** catches SIGINT (`CTRL` + `C`). 160 | * **socket** creates a TCP/IP connection to a local netcat server (requires *nc(1)*). 161 | * **stat** reads and outputs status of a file. 162 | * **time** prints out the results of time functions. 163 | * **uname** prints OS information from `uname()`. 164 | * **uptime** outputs system uptime. 165 | 166 | To compile the example programs, either run: 167 | 168 | ``` 169 | $ make freebsd_examples 170 | ``` 171 | 172 | Or: 173 | 174 | ``` 175 | $ make linux_examples 176 | ``` 177 | 178 | ## Licence 179 | 180 | ISC 181 | -------------------------------------------------------------------------------- /examples/dirent/dirent.f90: -------------------------------------------------------------------------------- 1 | ! dirent.f90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | program main 6 | !! Prints the contents of a file system directory to stdout (unsorted). 7 | use, intrinsic :: iso_fortran_env, only: stderr => error_unit 8 | use :: unix 9 | implicit none 10 | 11 | character(len=*), parameter :: PATH = '/' 12 | 13 | character(len=256) :: entry_name 14 | integer :: stat 15 | type(c_dirent), pointer :: dirent_ptr 16 | type(c_ptr) :: dir_ptr 17 | 18 | ! Open directory. 19 | dir_ptr = c_opendir(PATH // c_null_char) 20 | 21 | if (.not. c_associated(dir_ptr)) then 22 | write (stderr, '("Cannot open directory ", a)') PATH 23 | stop 24 | end if 25 | 26 | print '("Contents of directory ", a, ":")', PATH 27 | 28 | ! Read in directory entries and output file names. 29 | do 30 | ! Get next directory entry. 31 | dirent_ptr => f_readdir(dir_ptr) 32 | 33 | ! Exit if pointer is null. 34 | if (.not. associated(dirent_ptr)) exit 35 | 36 | ! Convert C char array to Fortran string. 37 | call c_f_str_chars(dirent_ptr%d_name, entry_name) 38 | 39 | select case (dirent_ptr%d_type) 40 | case (DT_DIR) 41 | ! Entry is directory. 42 | print '(2a)', trim(entry_name), '/' 43 | case default 44 | ! Entry is file. 45 | print '(a)', trim(entry_name) 46 | end select 47 | end do 48 | 49 | ! Close directory. 50 | stat = c_closedir(dir_ptr) 51 | end program main 52 | -------------------------------------------------------------------------------- /examples/fifo/fifo.f90: -------------------------------------------------------------------------------- 1 | ! fifo.f90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | program main 6 | !! Basic named pipe example. Creates a new named pipe `/tmp/fifo` and waits 7 | !! for input. Just write to the FIFO from another process: 8 | !! 9 | !! ``` 10 | !! $ echo "Hello, World!" > /tmp/fifo 11 | !! ``` 12 | use :: unix 13 | implicit none 14 | 15 | character(len=*), parameter :: PATH = '/tmp/fifo' ! Path to the named pipe. 16 | integer, parameter :: PERM = int(o'0666') ! Permissions (octal). 17 | 18 | integer :: c ! Single character. 19 | integer :: fd ! File descriptor. 20 | integer :: stat ! Return code. 21 | type(c_funptr) :: ptr ! Signal handler. 22 | type(c_ptr) :: stream ! Input stream. 23 | 24 | ! Create named pipe. 25 | stat = c_mkfifo(PATH // c_null_char, int(PERM, kind=c_mode_t)) 26 | 27 | if (stat < 0) then 28 | call c_perror('Error' // c_null_char) 29 | stop 30 | end if 31 | 32 | ! Add signal handler for SIGINT. 33 | ptr = c_signal(SIGINT, c_funloc(sigint_handler)) 34 | 35 | do 36 | print '(3a)', 'Waiting for input in "', path, '" ...' 37 | 38 | ! Open file descriptor (read-only) and stream (read-only). 39 | fd = c_open(PATH // c_null_char, O_RDONLY, int(S_IRUSR, kind=c_mode_t)) 40 | stream = c_fdopen(fd, 'r' // c_null_char) 41 | 42 | do 43 | c = c_fgetc(stream) 44 | if (c == EOF) exit 45 | write (*, '(a)', advance='no') achar(c) 46 | end do 47 | 48 | stat = c_fclose(stream) 49 | stat = c_close(fd) 50 | stat = c_usleep(10**6) 51 | end do 52 | 53 | ! Delete named pipe. 54 | stat = c_unlink(PATH // c_null_char) 55 | contains 56 | subroutine sigint_handler(signum) bind(c) 57 | !! Signal handler for SIGINT. Unlinks the named pipe on CTRL + C event. 58 | integer(kind=c_int), intent(in), value :: signum 59 | 60 | integer :: stat 61 | 62 | stat = c_unlink(PATH // c_null_char) 63 | stop 64 | end subroutine sigint_handler 65 | end program main 66 | -------------------------------------------------------------------------------- /examples/fork/fork.f90: -------------------------------------------------------------------------------- 1 | ! fork.f90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | program main 6 | !! Example program that forks the main process and opens two anonymous pipes 7 | !! for IPC. 8 | use :: unix 9 | implicit none 10 | 11 | integer, parameter :: READ_END = 1 ! Reader pipe. 12 | integer, parameter :: WRITE_END = 2 ! Writer pipe. 13 | 14 | character, target :: buf ! Byte buffer. 15 | character(len=32), target :: msg ! Message to transmit. 16 | 17 | integer :: pid ! Process id. 18 | integer :: pfds(2) ! File descriptors (reader/writer). 19 | integer :: stat ! Return code. 20 | integer(kind=c_size_t) :: nbytes 21 | 22 | ! Open anonymous pipe (read, write). 23 | stat = c_pipe(pfds) 24 | 25 | if (stat < 0) then 26 | print '("Creating anonymous pipe failed: ", i0)', stat 27 | stop 28 | end if 29 | 30 | ! Fork process. 31 | pid = c_fork() 32 | 33 | if (pid < 0) then 34 | ! 35 | ! Fork error. 36 | ! 37 | call c_perror('fork()' // c_null_char) 38 | else if (pid == 0) then 39 | ! 40 | ! Child process. 41 | ! 42 | print '(">>> child process running ...")' 43 | stat = c_close(pfds(WRITE_END)) 44 | 45 | print '(">>> child process is receiving message ...")' 46 | 47 | ! Read message from pipe, byte by byte. 48 | do while (c_read(pfds(READ_END), c_loc(buf), 1_c_size_t) > 0) 49 | write (*, '(a)', advance='no') buf 50 | end do 51 | 52 | stat = c_close(pfds(READ_END)) 53 | print '(/, ">>> child process done")' 54 | 55 | call c_exit(0) 56 | else 57 | ! 58 | ! Parent process. 59 | ! 60 | stat = c_close(pfds(READ_END)) 61 | 62 | ! Write message to pipe. 63 | print '("<<< parent process is sending message ...")' 64 | 65 | msg = 'Hi, there!' 66 | nbytes = c_write(pfds(WRITE_END), c_loc(msg), len(msg, kind=c_size_t)) 67 | 68 | if (nbytes < 0) print '("<<< writing to pipe failed")' 69 | 70 | stat = c_close(pfds(WRITE_END)) 71 | 72 | print '("<<< waiting for child ", i0, " ...")', pid 73 | print '("<<< child ", i0, " finished")', c_wait(stat) 74 | end if 75 | end program main 76 | -------------------------------------------------------------------------------- /examples/irc/irc.f90: -------------------------------------------------------------------------------- 1 | ! irc.f90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | module irc 6 | !! IRC connectivity module. 7 | use, intrinsic :: iso_fortran_env, only: i8 => int64, stderr => error_unit, stdout => output_unit 8 | use :: unix 9 | implicit none 10 | 11 | public :: irc_connect 12 | public :: irc_send 13 | public :: irc_send_message 14 | contains 15 | integer function irc_connect(hostname, port) result(fd) 16 | !! Creates a socket connection to `hostname`:`port`. The file descriptor 17 | !! of the socket is returned on success, -1 on failure. 18 | !! 19 | !! The source code has been adapted from the example listed at 20 | !! [https://man.openbsd.org/getaddrinfo.3](https://man.openbsd.org/getaddrinfo.3). 21 | character(len=*), intent(in) :: hostname 22 | integer, intent(in) :: port 23 | 24 | character(len=64), target :: host_str 25 | character(len=8), target :: port_str 26 | 27 | integer :: stat 28 | integer :: sock_fd 29 | type(c_ptr) :: ptr 30 | 31 | type(c_addrinfo), target :: hints 32 | type(c_addrinfo), target :: res 33 | type(c_addrinfo), pointer :: next 34 | 35 | character(len=:), allocatable :: err_str 36 | 37 | fd = -1 38 | 39 | host_str = trim(hostname) // c_null_char 40 | write (port_str, '(i0, a)') port, c_null_char 41 | 42 | ! Initialise derived type. 43 | hints%ai_family = AF_INET 44 | hints%ai_socktype = SOCK_STREAM 45 | hints%ai_flags = AI_NUMERICSERV 46 | 47 | ptr = c_loc(res) 48 | stat = c_getaddrinfo(node = c_loc(host_str), & 49 | service = c_loc(port_str), & 50 | hints = c_loc(hints), & 51 | res = ptr) 52 | 53 | ! Print error message of `c_getaddrinfo()`. 54 | if (stat /= 0) then 55 | ptr = c_gai_strerror(stat) 56 | call c_f_str_ptr(ptr, err_str) 57 | write (stderr, '("getaddrinfo(): ", a)') err_str 58 | return 59 | end if 60 | 61 | ! `c_getaddrinfo()` returns a list of address structures. 62 | ! Try each address until `c_connect()` is successful. 63 | call c_f_pointer(ptr, next) 64 | 65 | do while (associated(next)) 66 | sock_fd = c_socket(next%ai_family, next%ai_socktype, next%ai_protocol) 67 | 68 | if (sock_fd == -1) then 69 | call c_f_pointer(next%ai_next, next) 70 | cycle 71 | end if 72 | 73 | if (sock_fd < -1) then 74 | call c_perror('socket()' // c_null_char) 75 | return 76 | end if 77 | 78 | stat = c_connect(sock_fd, next%ai_addr, next%ai_addrlen) 79 | 80 | if (stat == -1) then 81 | call c_perror('connect()' // c_null_char) 82 | stat = c_close(sock_fd) 83 | return 84 | end if 85 | 86 | exit 87 | end do 88 | 89 | if (.not. associated(next)) then 90 | stat = c_close(sock_fd) 91 | return 92 | end if 93 | 94 | fd = sock_fd 95 | end function irc_connect 96 | 97 | integer(kind=i8) function irc_send(socket, bytes) result(nbytes) 98 | !! Sends string to socket (raw). 99 | character(len=*), parameter :: CR_LF = char(13) // char(10) 100 | 101 | integer, intent(in) :: socket 102 | character(len=*), intent(in) :: bytes 103 | 104 | character(len=:), allocatable, target :: buffer 105 | 106 | buffer = trim(bytes) // CR_LF 107 | nbytes = c_write(socket, c_loc(buffer), len(buffer, kind=c_size_t)) 108 | write (*, '("*** ", a, " (", i0, " Bytes)")') trim(bytes), nbytes 109 | end function irc_send 110 | 111 | integer(kind=i8) function irc_send_message(socket, channel, message) result(nbytes) 112 | !! Sends string as IRC message (PRIVMSG) to channel. 113 | integer, intent(in) :: socket 114 | character(len=*), intent(in) :: channel 115 | character(len=*), intent(in) :: message 116 | 117 | character(len=:), allocatable :: buffer 118 | 119 | buffer = 'PRIVMSG ' // trim(channel) // ' :' // trim(message) 120 | nbytes = irc_send(socket, buffer) 121 | end function irc_send_message 122 | end module irc 123 | 124 | program main 125 | !! Dumb IRC bot that connects to an IRC server, joins a channel, and sends a 126 | !! message each time someone mentions Fortran. 127 | !! 128 | !! You may want to change the following parameters to your liking: 129 | !! 130 | !! * `IRC_MSG` 131 | !! * `IRC_USERNAME` 132 | !! * `IRC_HOSTNAME` 133 | !! * `IRC_CHANNEL` 134 | !! * `IRC_PORT` 135 | use :: irc 136 | use :: unix 137 | implicit none 138 | 139 | character(len=*), parameter :: IRC_MSG = 'FORTRAN: The Greatest of the Programming Languages!' 140 | character(len=*), parameter :: IRC_USERNAME = 'forbot' 141 | character(len=*), parameter :: IRC_HOSTNAME = 'irc.libera.chat' 142 | character(len=*), parameter :: IRC_CHANNEL = '#bot-test' 143 | integer, parameter :: IRC_PORT = 6667 144 | 145 | character(len=512), target :: buffer ! Received message. 146 | integer :: sock_fd ! Socket file descriptor. 147 | integer(kind=i8) :: nbytes ! Bytes read/written. 148 | logical :: is_logged_in ! Send credentials. 149 | 150 | print '("<<< FORTRAN IRC BOT >>>")' 151 | print '("User: ", a)', trim(IRC_USERNAME) 152 | print '("Hostname: ", a)', trim(IRC_HOSTNAME) 153 | print '("Port: ", i0)', IRC_PORT 154 | print '("Channel: ", a, /)', trim(IRC_CHANNEL) 155 | 156 | ! Connect to IRC server. 157 | print '("*** Connecting to ", a, ":", i0)', trim(IRC_HOSTNAME), IRC_PORT 158 | 159 | sock_fd = irc_connect(IRC_HOSTNAME, IRC_PORT) 160 | 161 | if (sock_fd < 0) then 162 | write (stderr, '("Connection to server ", a, ":", i0, " failed")') trim(IRC_HOSTNAME), IRC_PORT 163 | stop 164 | end if 165 | 166 | ! Event loop. 167 | is_logged_in = .false. 168 | 169 | do 170 | ! Read from socket. 171 | nbytes = c_read(sock_fd, c_loc(buffer), len(buffer, kind=c_size_t)) 172 | if (nbytes <= 0) exit 173 | 174 | ! Write buffer to standard output. 175 | write (*, '(a)', advance='no') buffer(1:nbytes) 176 | 177 | ! Check for IRC server `PING` and answer with `PONG` + payload. 178 | if (index(buffer(1:nbytes), 'PING') == 1) then 179 | nbytes = irc_send(sock_fd, 'PONG ' // trim(buffer(6:len_trim(buffer) - 2))) 180 | end if 181 | 182 | ! Log-in and join channel. 183 | if (.not. is_logged_in) then 184 | nbytes = irc_send(sock_fd, 'NICK ' // trim(IRC_USERNAME)) 185 | nbytes = irc_send(sock_fd, 'USER ' // trim(IRC_USERNAME) // ' . . :' // trim(IRC_USERNAME)) 186 | nbytes = irc_send(sock_fd, 'JOIN ' // trim(IRC_CHANNEL)) 187 | is_logged_in = .true. 188 | end if 189 | 190 | ! Check for new channel message. 191 | if (index(buffer(1:nbytes), 'PRIVMSG ' // trim(IRC_CHANNEL) // ' :') > 0) then 192 | ! Check for 'Fortran' substring in received message and respond with 193 | ! sample message if found. 194 | if (index(string_lower(buffer(1:nbytes)), 'fortran') > 0) then 195 | nbytes = irc_send_message(sock_fd, IRC_CHANNEL, IRC_MSG) 196 | end if 197 | end if 198 | 199 | ! Clear buffer. 200 | buffer = ' ' 201 | end do 202 | 203 | ! Disconnect from server. 204 | nbytes = irc_send(sock_fd, 'QUIT') 205 | 206 | ! Close connection. 207 | if (c_close(sock_fd) /= 0) then 208 | call c_perror('Error' // c_null_char) 209 | stop 210 | end if 211 | contains 212 | pure elemental function string_lower(str) result(lower) 213 | !! Returns given string in lower case. 214 | character(len=*), intent(in) :: str !! String to convert. 215 | character(len=len(str)) :: lower !! Result. 216 | 217 | character :: a 218 | integer :: i 219 | 220 | do i = 1, len(str) 221 | a = str(i:i) 222 | if (a >= 'A' .and. a <= 'Z') a = achar(iachar(a) + 32) 223 | lower(i:i) = a 224 | end do 225 | end function string_lower 226 | end program main 227 | -------------------------------------------------------------------------------- /examples/key/key.f90: -------------------------------------------------------------------------------- 1 | ! key.f90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | program main 6 | !! Reads single key-strokes from standard input. 7 | use :: unix 8 | implicit none 9 | 10 | integer :: ich 11 | 12 | call set_mode(1) 13 | 14 | print '("Press to quit.")' 15 | 16 | do 17 | ich = next_char() 18 | print '("Key pressed: ", i0)', ich 19 | if (ich == iachar('q')) exit 20 | end do 21 | 22 | call set_mode(0) 23 | contains 24 | integer function next_char() result(ich) 25 | ich = c_getchar() 26 | end function next_char 27 | 28 | subroutine set_mode(mode) 29 | integer, intent(in) :: mode 30 | 31 | integer :: stat 32 | integer(kind=c_int64_t) :: c_lflag 33 | type(c_termios) :: term_attr 34 | type(c_termios), save :: save_attr 35 | 36 | if (mode == 0) then 37 | stat = c_tcsetattr(STDIN_FILENO, TCSADRAIN, save_attr) 38 | else 39 | stat = c_tcgetattr(STDIN_FILENO, term_attr) 40 | 41 | save_attr = term_attr 42 | 43 | c_lflag = c_uint_to_int(term_attr%c_lflag) 44 | c_lflag = iand(c_lflag, not(int(ior(ICANON, ECHO), kind=c_int64_t))) 45 | 46 | term_attr%c_lflag = c_int_to_uint(c_lflag) 47 | term_attr%c_cc(VMIN) = 1_c_cc_t 48 | term_attr%c_cc(VTIME) = 0_c_cc_t 49 | 50 | stat = c_tcsetattr(STDIN_FILENO, TCSANOW, term_attr) 51 | end if 52 | end subroutine set_mode 53 | end program main 54 | -------------------------------------------------------------------------------- /examples/mqueue/mqueue.f90: -------------------------------------------------------------------------------- 1 | ! mqueue.f90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | program main 6 | !! Example that sends and receives a message with POSIX message queues. 7 | !! 8 | !! On FreeBSD, make sure the kernel module `mqueuefs` is loaded and the 9 | !! message queue file system is mounted: 10 | !! 11 | !! ``` 12 | !! # kldload mqueuefs 13 | !! # mkdir -p /mnt/mqueue 14 | !! # mount -t mqueuefs null /mnt/mqueue 15 | !! ``` 16 | !! 17 | !! To load the module at boot time, add to `/etc/rc.conf`: 18 | !! 19 | !! ``` 20 | !! kld_list+="mqueuefs" 21 | !! ``` 22 | !! 23 | !! You may want to define an entry in `/etc/fstab`: 24 | !! 25 | !! ``` 26 | !! null /mnt/mqueue mqueuefs rw 0 0 27 | !! ``` 28 | !! 29 | !! Zombie message queues are deleted with `unlink`: 30 | !! 31 | !! ``` 32 | !! $ unlink /mnt/mqueue/ 33 | !! ``` 34 | !! 35 | !! You can get/set the system limits with `sysctl` on FreeBSD: 36 | !! 37 | !! ``` 38 | !! $ sysctl kern.mqueue.maxmsg 39 | !! $ sysctl kern.mqueue.maxmsgsize 40 | !! ``` 41 | !! 42 | !! By default, new message queues are limited to 10 messages with a message 43 | !! size of 1024 bytes. 44 | !! 45 | !! On Linux, mount the message queue file system with: 46 | !! 47 | !! ``` 48 | !! $ mkdir -p /dev/mqueue 49 | !! $ mount -t mqueue none /dev/mqueue 50 | !! ``` 51 | !! 52 | !! This example runs in a single process. For inter-process communication, 53 | !! each thread or process may connect individually to the message queue, but 54 | !! make sure only one of them creates the message queue. 55 | !! 56 | !! The size of the buffer passed to `c_mq_receive()` must be greater than 57 | !! the MQ message size given by `mq_getattr()`. We may set the max. message 58 | !! size with `mq_setattr()` beforehand. 59 | use :: unix 60 | implicit none 61 | character(len=*), parameter :: MQ_NAME = '/fortran' ! New MQ in, e.g., `/mnt/mqueue/`. 62 | integer, parameter :: MQ_PERM = int(o'0644') ! MQ permissions (octal). 63 | 64 | character(len=16384) :: buf ! Input buffer (must be greater than the MQ max. message size). 65 | character(len=32) :: msg ! Sample message. 66 | integer :: prio ! Priority. 67 | integer :: stat ! Return code. 68 | integer(kind=c_mqd_t) :: mqds ! MQ file descriptor. 69 | integer(kind=c_size_t) :: sz ! Bytes received. 70 | type(c_mq_attr) :: attr ! MQ attributes. 71 | 72 | ! Unlink, if MQ already exists. 73 | stat = c_mq_unlink(MQ_NAME // c_null_char) 74 | 75 | ! Create new message queue `/fortran`. 76 | print '(">>> Opening message queue ...")' 77 | 78 | mqds = c_mq_open(name = MQ_NAME // c_null_char, & 79 | oflag = ior(O_CREAT, O_RDWR), & 80 | mode = int(MQ_PERM, kind=c_mode_t), & 81 | attr = c_null_ptr) 82 | 83 | if (mqds < 0) then 84 | call c_perror('mq_open()' // c_null_char) 85 | stop 86 | end if 87 | 88 | ! Get message queue attributes. 89 | print '(">>> Getting attributes ...")' 90 | 91 | stat = c_mq_getattr(mqds, attr) 92 | if (stat < 0) call c_perror('mq_getattr()' // c_null_char) 93 | 94 | print '(/, "MQ flags.............: ", i0)', attr%mq_flags 95 | print '("MQ max. # of messages: ", i0)', attr%mq_maxmsg 96 | print '("MQ max. message size.: ", i0)', attr%mq_msgsize 97 | print '("Current # of messages: ", i0, /)', attr%mq_curmsgs 98 | 99 | ! Send message. 100 | print '(">>> Sending message ...")' 101 | 102 | msg = 'Hello, World!' 103 | stat = c_mq_send(mqds, msg, len_trim(msg, kind=c_size_t), 1) 104 | 105 | if (stat < 0) call c_perror('mq_send()' // c_null_char) 106 | 107 | ! Receive message. 108 | print '(">>> Waiting for message ...")' 109 | 110 | buf = ' ' ! Make sure to clear buffer! 111 | sz = c_mq_receive(mqds, buf, len(buf, kind=c_size_t), prio) 112 | 113 | if (sz < 0) then 114 | call c_perror('mq_receive()' // c_null_char) 115 | else if (sz > 0) then 116 | print '(">>> Received: ", a)', trim(buf) 117 | else 118 | print '(">>> No message received")' 119 | end if 120 | 121 | ! Close message queue. 122 | print '(">>> Closing message queue ...")' 123 | 124 | stat = c_mq_close(mqds) 125 | if (stat < 0) call c_perror('mq_close()' // c_null_char) 126 | 127 | ! Unlink. 128 | stat = c_mq_unlink(MQ_NAME // c_null_char) 129 | end program main 130 | -------------------------------------------------------------------------------- /examples/msg/msg.f90: -------------------------------------------------------------------------------- 1 | ! msg.f90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | module ipc 6 | !! IPC abstraction module. 7 | use :: unix 8 | implicit none 9 | private 10 | 11 | public :: ipc_receive 12 | public :: ipc_send 13 | 14 | integer(kind=c_size_t), parameter, public :: MESSAGE_LEN = 512 !! Message length. 15 | integer(kind=c_long), parameter, public :: MESSAGE_TYPE = 1 !! Message type id. 16 | 17 | type, bind(c), public :: c_message_type 18 | !! Our message type implementation. 19 | integer(kind=c_long) :: type 20 | character(kind=c_char) :: text(MESSAGE_LEN) 21 | end type c_message_type 22 | contains 23 | integer(kind=c_size_t) function ipc_receive(msqid, type, text, flag) result(nbytes) 24 | !! Waits for message of given type and returns message text. Calling the 25 | !! function is blocking, unless `flag` is set to `IPC_NOWAIT`. 26 | integer, intent(in) :: msqid 27 | integer(kind=c_long), intent(in) :: type 28 | character(len=*), intent(out) :: text 29 | integer, intent(in) :: flag 30 | 31 | type(c_message_type), target :: message 32 | 33 | nbytes = c_msgrcv(msqid, c_loc(message), c_sizeof(message%text), type, flag) 34 | 35 | ! Copy C char array to Fortran character. 36 | if (nbytes > 0) then 37 | call c_f_str_chars(message%text, text) 38 | end if 39 | end function ipc_receive 40 | 41 | integer function ipc_send(msqid, type, text, flag) result(stat) 42 | !! Converts Fortran string to C char array, and then sends message of 43 | !! given type by calling `c_msgsnd()`. 44 | integer, intent(in) :: msqid 45 | integer(kind=c_long), intent(in) :: type 46 | character(len=*), intent(in) :: text 47 | integer, intent(in) :: flag 48 | 49 | type(c_message_type), target :: message 50 | 51 | message%type = type 52 | call f_c_str_chars(text, message%text) 53 | stat = c_msgsnd(msqid, c_loc(message), c_sizeof(message%text), flag) 54 | end function ipc_send 55 | end module ipc 56 | 57 | program main 58 | !! Example that sends and receives a message with UNIX System V message 59 | !! queues. 60 | use, intrinsic :: iso_fortran_env, only: stderr => error_unit, stdout => output_unit 61 | use :: unix 62 | use :: ipc 63 | implicit none 64 | 65 | character(len=*), parameter :: MSG = 'Hello, World!' ! Sample message. 66 | integer, parameter :: PERM = int(o'0666') ! Permissions (octal). 67 | 68 | character(len=MESSAGE_LEN) :: buf ! Message text buffer. 69 | integer :: msqid ! Message queue id. 70 | integer :: stat ! Return code. 71 | integer(kind=c_size_t) :: nbytes 72 | 73 | ! Create new message queue. 74 | msqid = c_msgget(IPC_PRIVATE, ior(IPC_CREAT, PERM)) 75 | 76 | if (msqid < 0) then 77 | call c_perror('msgget()' // c_null_char) 78 | stop 79 | end if 80 | 81 | print '("Message Queue ID: ", i0, /)', msqid 82 | 83 | ! Send message to message queue. 84 | print '("Sending message ...")' 85 | 86 | nbytes = ipc_send(msqid, MESSAGE_TYPE, MSG, IPC_NOWAIT) 87 | 88 | if (nbytes < 0) then 89 | call c_perror('ipc_send()' // c_null_char) 90 | else 91 | print '("Done.")' 92 | end if 93 | 94 | ! Receive message from message queue (blocking I/O). 95 | print '("Receiving message ...")' 96 | 97 | nbytes = ipc_receive(msqid, MESSAGE_TYPE, buf, 0) 98 | 99 | if (nbytes < 0) then 100 | call c_perror('ipc_receive()' // c_null_char) 101 | else 102 | print '("Received: ", a)', trim(buf) 103 | end if 104 | 105 | ! Remove message queue. 106 | print '("Closing message queue ...")' 107 | 108 | stat = c_msgctl(msqid, IPC_RMID, c_null_ptr) 109 | if (stat < 0) call c_perror('msgctl()' // c_null_char) 110 | end program main 111 | -------------------------------------------------------------------------------- /examples/mutex/mutex.f90: -------------------------------------------------------------------------------- 1 | ! mutex.f90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | module mutex 6 | !! Mutex module. 7 | use :: unix 8 | implicit none 9 | 10 | type(c_pthread_mutex_t), save :: mutex_sample 11 | integer, save :: value_sample = 0 12 | contains 13 | recursive subroutine mutex_update(arg) bind(c) 14 | type(c_ptr), intent(in), value :: arg ! Client data. 15 | 16 | integer, pointer :: n ! Fortran pointer to client data. 17 | integer :: stat ! Return code. 18 | 19 | if (.not. c_associated(arg)) return 20 | call c_f_pointer(arg, n) 21 | 22 | stat = c_pthread_mutex_lock(mutex_sample) 23 | 24 | print '("Thread ", i2, " changes value from ", i2, " to ", i2)', n, value_sample, n 25 | value_sample = n 26 | 27 | stat = c_pthread_mutex_unlock(mutex_sample) 28 | end subroutine mutex_update 29 | end module mutex 30 | 31 | program main 32 | !! Example that shows threaded access to a global variable, using a mutex. 33 | use :: unix 34 | use :: mutex 35 | implicit none 36 | integer, parameter :: NTHREADS = 16 37 | 38 | integer :: i, stat 39 | integer, target :: routines(NTHREADS) = [ (i, i = 1, NTHREADS) ] 40 | type(c_pthread_t) :: threads(NTHREADS) 41 | type(c_ptr) :: ptr 42 | 43 | stat = c_pthread_mutex_init(mutex_sample, c_null_ptr) 44 | 45 | print '("Starting threads ...")' 46 | 47 | do i = 1, NTHREADS 48 | stat = c_pthread_create(thread = threads(i), & 49 | attr = c_null_ptr, & 50 | start_routine = c_funloc(mutex_update), & 51 | arg = c_loc(routines(i))) 52 | end do 53 | 54 | print '("Joining threads ...")' 55 | 56 | do i = 1, NTHREADS 57 | stat = c_pthread_join(threads(i), ptr) 58 | end do 59 | 60 | stat = c_pthread_mutex_destroy(mutex_sample) 61 | end program main 62 | -------------------------------------------------------------------------------- /examples/os/os.F90: -------------------------------------------------------------------------------- 1 | ! os.f90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | module os 6 | !! Utility module. 7 | implicit none 8 | private 9 | 10 | integer, parameter, public :: OS_UNKNOWN = 0 11 | integer, parameter, public :: OS_WINDOWS = 1 12 | integer, parameter, public :: OS_MACOS = 2 13 | integer, parameter, public :: OS_LINUX = 3 14 | integer, parameter, public :: OS_FREEBSD = 4 15 | 16 | public :: os_type 17 | contains 18 | function os_type() 19 | integer :: os_type 20 | 21 | #if defined (WIN32) || defined (_WIN32) || defined (__WIN32__) || defined (__NT__) 22 | os_type = OS_WINDOWS 23 | #elif defined (__APPLE__) 24 | os_type = OS_MACOS 25 | #elif defined (__linux__) 26 | os_type = OS_LINUX 27 | #elif defined (__FreeBSD__) 28 | os_type = OS_FREEBSD 29 | #else 30 | os_type = OS_UNKNOWN 31 | #endif 32 | end function os_type 33 | end module os 34 | 35 | program main 36 | !! Prints the name of the operating system to stdout, using pre-processor 37 | !! macros. Pass the parameter `-D____` to GNU Fortran, for 38 | !! example: 39 | !! 40 | !! ``` 41 | !! $ gfortran -D__linux__ -o os os.F90 42 | !! $ gfortran -D__FreeBSD__ -o os os.F90 43 | !! $ gfortran -D__APPLE__ -o os os.F90 44 | !! $ ifort -o os os.F90 45 | !! ``` 46 | use :: os 47 | implicit none 48 | integer :: current_os 49 | 50 | print '("Current Operating System")' 51 | print '(24("-"))' 52 | 53 | current_os = os_type() 54 | 55 | write (* , '("Name: ")', advance='no') 56 | 57 | select case (current_os) 58 | case (OS_UNKNOWN) 59 | print '("Unknown OS")' 60 | 61 | case (OS_WINDOWS) 62 | print '("Microsoft Windows (Cygwin, MSYS2)")' 63 | 64 | case (OS_MACOS) 65 | print '("macOS")' 66 | 67 | case (OS_LINUX) 68 | print '("GNU/Linux")' 69 | 70 | case (OS_FREEBSD) 71 | print '("FreeBSD")' 72 | 73 | case default 74 | print '("Error")' 75 | end select 76 | end program main 77 | -------------------------------------------------------------------------------- /examples/pid/pid.f90: -------------------------------------------------------------------------------- 1 | ! pid.f90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | program main 6 | !! Example program that outputs the process id. 7 | use :: unix 8 | implicit none 9 | 10 | print '("PID: ", i0)', c_getpid() 11 | end program main 12 | -------------------------------------------------------------------------------- /examples/pipe/pipe.f90: -------------------------------------------------------------------------------- 1 | ! pipe.f90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | program main 6 | !! Example that demonstrates IPC via bidirectional pipes. 7 | use :: unix 8 | implicit none 9 | 10 | character(len=6) :: message 11 | character(len=32) :: buffer 12 | type(c_ptr) :: stdin, stdout 13 | 14 | call pipe_open2('cat -n', stdin, stdout) 15 | 16 | if (.not. c_associated(stdin) .or. .not. c_associated(stdout)) then 17 | stop 'Error: pipe_open2() failed' 18 | end if 19 | 20 | ! Send message, equivalent to: 21 | ! $ echo "Hello!" | cat -n 22 | message = 'Hello!' 23 | 24 | print '("Parent: ", a)', trim(message) 25 | call pipe_write(stdin, message) 26 | 27 | ! Read from stdout of child process. 28 | call pipe_read(stdout, buffer) 29 | print '("Child: ", a)', trim(buffer) 30 | contains 31 | subroutine pipe_open2(command, stdin, stdout) 32 | character(len=*), intent(in) :: command 33 | type(c_ptr), intent(out) :: stdin 34 | type(c_ptr), intent(out) :: stdout 35 | 36 | integer :: p1(2), p2(2) 37 | integer :: pid, stat 38 | 39 | stat = c_pipe(p1) 40 | stat = c_pipe(p2) 41 | 42 | pid = c_fork() 43 | 44 | if (pid < 0) then 45 | ! Fork error. 46 | call c_perror('fork()' // c_null_char) 47 | else if (pid == 0) then 48 | ! Child process. 49 | stat = c_close(p1(2)) 50 | stat = c_close(p2(1)) 51 | 52 | stat = c_dup2(p1(1), STDIN_FILENO) 53 | stat = c_dup2(p2(2), STDOUT_FILENO) 54 | 55 | stat = c_execl('/bin/sh' // c_null_char, & 56 | '/bin/sh' // c_null_char, & 57 | '-c' // c_null_char, & 58 | command // c_null_char, & 59 | c_null_ptr) 60 | call c_exit(0) 61 | else 62 | ! Parent process. 63 | stat = c_close(p1(1)) 64 | stat = c_close(p2(2)) 65 | 66 | stdin = c_fdopen(p1(2), 'w' // c_null_char) 67 | stdout = c_fdopen(p2(1), 'r' // c_null_char) 68 | end if 69 | end subroutine pipe_open2 70 | 71 | subroutine pipe_read(pipe, str) 72 | type(c_ptr), intent(in) :: pipe 73 | character(len=*), target, intent(inout) :: str 74 | 75 | integer :: stat 76 | integer(kind=c_size_t) :: sz 77 | 78 | str = ' ' 79 | sz = c_fread(c_loc(str), 1_c_size_t, len(str, kind=c_size_t), pipe) 80 | stat = c_fclose(pipe) 81 | end subroutine pipe_read 82 | 83 | subroutine pipe_write(pipe, str) 84 | type(c_ptr), intent(in) :: pipe 85 | character(len=*), target, intent(inout) :: str 86 | 87 | integer :: stat 88 | integer(kind=c_size_t) :: sz 89 | 90 | sz = c_fwrite(c_loc(str), 1_c_size_t, len(str, kind=c_size_t), pipe) 91 | stat = c_fclose(pipe) 92 | end subroutine pipe_write 93 | end program main 94 | -------------------------------------------------------------------------------- /examples/pthread/pthread.f90: -------------------------------------------------------------------------------- 1 | ! pthread.f90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | program main 6 | !! Example that shows how to run a routine inside several POSIX threads. 7 | use :: unix 8 | implicit none 9 | 10 | integer, parameter :: NTHREADS = 3 11 | 12 | integer :: i, stat 13 | integer, target :: routines(NTHREADS) = [ (i, i = 1, NTHREADS) ] 14 | type(c_pthread_t) :: threads(NTHREADS) 15 | type(c_ptr) :: ptr 16 | 17 | print '("Starting threads ...")' 18 | 19 | do i = 1, NTHREADS 20 | stat = c_pthread_create(thread = threads(i), & 21 | attr = c_null_ptr, & 22 | start_routine = c_funloc(hello), & 23 | arg = c_loc(routines(i))) 24 | end do 25 | 26 | print '("Joining threads ...")' 27 | 28 | do i = 1, NTHREADS 29 | stat = c_pthread_join(threads(i), ptr) 30 | end do 31 | contains 32 | recursive subroutine hello(arg) bind(c) 33 | type(c_ptr), intent(in), value :: arg ! Client data. 34 | 35 | integer, pointer :: n ! Fortran pointer to client data. 36 | integer :: i, stat 37 | 38 | if (.not. c_associated(arg)) return 39 | call c_f_pointer(arg, n) 40 | 41 | do i = 1, 5 42 | print '("--- Thread #", i0, " - Loop iteration ", i0)', n, i 43 | stat = c_usleep(10**6) 44 | end do 45 | end subroutine hello 46 | end program main 47 | -------------------------------------------------------------------------------- /examples/regex/regex.f90: -------------------------------------------------------------------------------- 1 | ! regex.f90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | program main 6 | !! Example that does basic pattern matching with POSIX regular expressions. 7 | use :: unix 8 | implicit none 9 | 10 | character(len=*), parameter :: STRING = 'fortran' 11 | character(len=*), parameter :: PATTERN = '^[:lower:]*' 12 | 13 | character(len=32), target :: err_str 14 | integer :: stat 15 | integer(kind=c_size_t) :: sz 16 | type(c_regex_t) :: regex 17 | 18 | ! Compile regular expression. 19 | stat = c_regcomp(regex, PATTERN // c_null_char, 0) 20 | 21 | ! Check for errors. 22 | if (stat /= 0) then 23 | sz = c_regerror(errcode = stat, & 24 | preg = regex, & 25 | errbuf = c_loc(err_str), & 26 | errbuf_size = len(err_str, kind=c_size_t)) 27 | 28 | if (sz > 0) then 29 | print '("regcomp(): ", a)', trim(err_str) 30 | else 31 | call c_perror('regerror()' // c_null_char) 32 | end if 33 | end if 34 | 35 | ! Execute regular expression. Returns 0 if pattern matches. 36 | stat = c_regexec(preg = regex, & 37 | string = STRING // c_null_char, & 38 | nmatch = 0_c_size_t, & 39 | pmatch = c_null_ptr, & 40 | eflags = 0) 41 | 42 | if (stat == 0) then 43 | print '("Pattern matches!")' 44 | else if (stat == REG_NOMATCH) then 45 | print '("Pattern does not match.")' 46 | end if 47 | 48 | ! Does not free `regex` itself. 49 | call c_regfree(regex) 50 | end program main 51 | -------------------------------------------------------------------------------- /examples/semaphore/semaphore.f90: -------------------------------------------------------------------------------- 1 | ! semaphore.f90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | program main 6 | !! Basic example that demonstrates the use of an unnamed POSIX semaphore. 7 | !! In contrast to named semaphores, unnamed ones have to be passed as C 8 | !! pointers to POSIX function interfaces other than `c_sem_init()` and 9 | !! `c_sem_destroy()`. 10 | use :: unix 11 | implicit none 12 | 13 | integer, parameter :: NTHREADS = 2 14 | 15 | type(c_funptr) :: procs(NTHREADS) 16 | type(c_pthread_t) :: threads(NTHREADS) 17 | type(c_sem_t), target :: sem 18 | type(c_ptr) :: ptr 19 | 20 | integer :: i, stat 21 | integer, target :: routines(NTHREADS) = [ (i, i = 1, NTHREADS) ] 22 | 23 | procs(1) = c_funloc(thread_fetch) 24 | procs(2) = c_funloc(thread_process) 25 | 26 | print '("--- Creating semaphore ...")' 27 | stat = c_sem_init(sem, 0) 28 | if (stat /= 0) stop 'Error: sem_init() failed' 29 | 30 | print '("--- Creating threads ...")' 31 | 32 | do i = 1, NTHREADS 33 | stat = c_pthread_create(thread = threads(i), & 34 | attr = c_null_ptr, & 35 | start_routine = procs(i), & 36 | arg = c_loc(routines(i))) 37 | end do 38 | 39 | print '("--- Joining threads ...")' 40 | 41 | do i = 1, NTHREADS 42 | stat = c_pthread_join(threads(i), ptr) 43 | end do 44 | 45 | stat = c_sem_destroy(sem) 46 | if (stat == 0) print '("--- Semaphore destroyed")' 47 | contains 48 | recursive subroutine thread_fetch(arg) bind(c) 49 | type(c_ptr), intent(in), value :: arg ! Client data. 50 | 51 | integer :: i, stat 52 | 53 | do i = 1, 5 54 | print '(">>> Simulating data fetching ...")' 55 | stat = c_usleep(2 * 10**6) 56 | print '(">>> Incrementing semaphore value ...")' 57 | stat = c_sem_post(c_loc(sem)) 58 | end do 59 | end subroutine thread_fetch 60 | 61 | recursive subroutine thread_process(arg) bind(c) 62 | type(c_ptr), intent(in), value :: arg ! Client data. 63 | 64 | integer :: i, stat 65 | 66 | do i = 1, 5 67 | print '("--- Waiting for semaphore ...")' 68 | stat = c_sem_wait(c_loc(sem)) 69 | 70 | if (stat == 0) then 71 | print '("--- Simulating data processing ...")' 72 | stat = c_usleep(3 * 10**6) 73 | end if 74 | end do 75 | end subroutine thread_process 76 | end program main 77 | -------------------------------------------------------------------------------- /examples/serial/serial.f90: -------------------------------------------------------------------------------- 1 | ! serial.f90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | module serial 6 | !! Serial port access module. 7 | use, intrinsic :: iso_fortran_env, only: i8 => int64 8 | use :: unix 9 | implicit none 10 | 11 | public :: serial_close 12 | public :: serial_open 13 | public :: serial_read 14 | public :: serial_set_attributes 15 | public :: serial_set_blocking 16 | public :: serial_write 17 | contains 18 | integer function serial_close(fd) result(stat) 19 | !! Closes file descriptor. 20 | integer, intent(in) :: fd 21 | 22 | stat = c_close(fd) 23 | end function serial_close 24 | 25 | integer function serial_open(port_name, access_mode) result(fd) 26 | !! Open serial connection to given port. `access_mode` has to be either 27 | !! `O_RDONLY` (read-only), `O_WRONLY` (write-only), or `O_RDWR` 28 | !! (read-write). 29 | character(len=*), intent(in) :: port_name 30 | integer, intent(in) :: access_mode 31 | integer :: flags 32 | 33 | flags = ior(O_NOCTTY, O_SYNC) 34 | flags = ior(flags, access_mode) 35 | 36 | fd = c_open(trim(port_name) // c_null_char, flags, 0_c_mode_t) 37 | end function serial_open 38 | 39 | integer(kind=i8) function serial_read(fd, a) result(nbytes) 40 | !! Reads a single byte from file descriptor to `a`. Returns number of 41 | !! bytes read. 42 | integer, intent(in) :: fd 43 | character, target, intent(out) :: a 44 | 45 | nbytes = c_read(fd, c_loc(a), 1_c_size_t) 46 | end function serial_read 47 | 48 | integer function serial_set_attributes(fd, speed, byte_size, stop_bits, parity, timeout) result(stat) 49 | !! Sets terminal attributes. 50 | integer, intent(in) :: fd !! File descriptor. 51 | integer, intent(in) :: speed !! Baud rate (`B4800`, `B9600`, `B19200`, ...). 52 | integer, intent(in) :: byte_size !! Byte size (`CS5`, `CS6`, `CS7`, `CS8`). 53 | integer, intent(in) :: stop_bits !! Number of stop bits (0 for one, `CSTOPB` for two). 54 | integer, intent(in) :: parity !! Parity (0 for none, `PARENB` for even, `ior(PARENB, PARODD)` for odd). 55 | integer, intent(in) :: timeout !! Timeout in 1/10 seconds. 56 | 57 | integer(kind=c_tcflag_t) :: c_cflag 58 | integer(kind=c_tcflag_t) :: c_iflag 59 | integer(kind=c_tcflag_t) :: c_lflag 60 | integer(kind=c_tcflag_t) :: c_oflag 61 | 62 | type(c_termios) :: tty 63 | 64 | ! Get current attributes. 65 | stat = c_tcgetattr(fd, tty) 66 | if (stat /= 0) return 67 | 68 | ! Set baud rate (I/O). 69 | stat = c_cfsetispeed(tty, speed); if (stat /= 0) return 70 | stat = c_cfsetospeed(tty, speed); if (stat /= 0) return 71 | 72 | c_cflag = int(c_uint_to_int(tty%c_cflag), kind=c_tcflag_t) 73 | c_iflag = int(c_uint_to_int(tty%c_iflag), kind=c_tcflag_t) 74 | c_oflag = int(c_uint_to_int(tty%c_oflag), kind=c_tcflag_t) 75 | c_lflag = int(c_uint_to_int(tty%c_lflag), kind=c_tcflag_t) 76 | 77 | c_cflag = ior (c_cflag, ior(CLOCAL, CREAD)) ! Ignore modem controls, enable reading. 78 | c_cflag = iand(c_cflag, not(CSIZE)) ! Unset byte size. 79 | c_cflag = ior (c_cflag, byte_size) ! Set byte size. 80 | c_cflag = iand(c_cflag, not(CSTOPB)) ! Unset stop bits. 81 | c_cflag = ior (c_cflag, stop_bits) ! Set stop bits. 82 | c_cflag = iand(c_cflag, not(ior(PARENB, PARODD))) ! Unset parity 83 | c_cflag = ior (c_cflag, parity) ! Set parity 84 | 85 | c_iflag = iand(c_iflag, not(IGNBRK)) ! Disable break processing. 86 | c_iflag = ior (c_iflag, ICRNL) ! Translate carriage-return to new-line. 87 | c_iflag = iand(c_iflag, not(IXON + IXOFF + IXANY)) ! Turn XON/XOFF control off. 88 | 89 | c_oflag = 0 ! No remapping, no delays. 90 | c_lflag = 0 ! No signaling chars, no echo, no canonical processing. 91 | 92 | tty%c_cflag = c_cflag 93 | tty%c_iflag = c_iflag 94 | tty%c_oflag = c_oflag 95 | tty%c_lflag = c_lflag 96 | 97 | tty%c_cc(VMIN) = 0 ! Read doesn't block. 98 | tty%c_cc(VTIME) = int(timeout, kind=c_cc_t) ! Read timeout in 1/10 seconds. 99 | 100 | ! Set attributes. 101 | stat = c_tcsetattr(fd, TCSANOW, tty) 102 | end function serial_set_attributes 103 | 104 | integer function serial_set_blocking(fd, is_blocking, timeout) result(stat) 105 | !! Set terminal read mode to blocking/non-blocking. 106 | integer, intent(in) :: fd 107 | logical, intent(in) :: is_blocking 108 | integer, intent(in), optional :: timeout 109 | 110 | type(c_termios) :: tty 111 | 112 | stat = c_tcgetattr(fd, tty) 113 | if (stat /= 0) return 114 | 115 | if (is_blocking) then 116 | tty%c_cc(VMIN) = 1 117 | else 118 | tty%c_cc(VMIN) = 0 119 | 120 | if (present(timeout)) then 121 | tty%c_cc(VTIME) = int(timeout, kind=c_cc_t) 122 | end if 123 | end if 124 | 125 | stat = c_tcsetattr(fd, TCSANOW, tty) 126 | end function serial_set_blocking 127 | 128 | integer(kind=i8) function serial_write(fd, a) result(nbytes) 129 | !! Writes single byte to terminal, returns number of bytes written. 130 | integer, intent(in) :: fd 131 | character, target, intent(in) :: a 132 | 133 | nbytes = c_write(fd, c_loc(a), 1_c_size_t) 134 | end function serial_write 135 | end module serial 136 | 137 | program main 138 | !! Reads from a serial port, and prints received characters to screen. 139 | !! Create two pseudo-terminals with socat(1): 140 | !! 141 | !! ``` 142 | !! $ socat -d -d pty,raw,echo=0 pty,raw,echo=0 143 | !! 2021/11/20 21:37:31 socat[40743] N PTY is /dev/pts/5 144 | !! 2021/11/20 21:37:31 socat[40743] N PTY is /dev/pts/6 145 | !! 2021/11/20 21:37:31 socat[40743] N starting data transfer loop with FDs [5,5] and [7,7] 146 | !! ``` 147 | !! 148 | !! Run the example program with one of the terminals as an argument: 149 | !! 150 | !! ``` 151 | !! $ ./serial /dev/pts/5 152 | !! ``` 153 | !! 154 | !! Open the other terminal with minicom(1): 155 | !! 156 | !! ``` 157 | !! $ minicom -p /dev/pts/6 158 | !! ``` 159 | !! 160 | !! The characters typed into minicom are printed by the program, until 161 | !! `CTRL` + `C` or a new line is sent. 162 | use :: serial 163 | use :: unix 164 | implicit none 165 | 166 | character :: a 167 | integer :: fd, stat 168 | integer(kind=i8) :: nbytes 169 | character(len=72) :: path 170 | 171 | ! Get path to pseudo-terminal. 172 | if (command_argument_count() /= 1) then 173 | stop 'Error: Path to TTY is missing' 174 | end if 175 | 176 | call get_command_argument(1, path) 177 | 178 | ! Open serial connection to pseudo-terminal. 179 | fd = serial_open(path, O_RDWR) 180 | if (fd <= 0) stop 'Error: Failed to open TTY' 181 | 182 | ! Set terminal settings: 183 | ! 9600 baud, 8 bits per byte, 1 stop bit, no parity, 1 sec. timeout. 184 | stat = serial_set_attributes(fd, B9600, CS8, 0, 0, 10) 185 | 186 | ! Enable blocking access. 187 | stat = serial_set_blocking(fd, .true., 10) 188 | 189 | ! Read and print characters to screen until CTRL + C or new-line is 190 | ! received. 191 | do 192 | nbytes = serial_read(fd, a) 193 | if (nbytes == 0) exit 194 | write (*, '(a)', advance='no') a 195 | if (iachar(a) == 3 .or. a == new_line(a)) exit 196 | end do 197 | 198 | ! Close serial connection. 199 | stat = serial_close(fd) 200 | end program main 201 | -------------------------------------------------------------------------------- /examples/signal/signal.f90: -------------------------------------------------------------------------------- 1 | ! signal.f90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | program main 6 | !! Example program that registers a signal handler for SIGINT. 7 | use :: unix 8 | implicit none 9 | integer :: stat 10 | type(c_funptr) :: ptr 11 | 12 | ! Register signal handler. 13 | ptr = c_signal(SIGINT, c_funloc(sigint_handler)) 14 | 15 | print '("Press CTRL + C to send SIGINT.")' 16 | 17 | do 18 | print '("zzz ...")' 19 | stat = c_usleep(10**6) 20 | end do 21 | contains 22 | subroutine sigint_handler(signum) bind(c) 23 | !! Signal handler for SIGINT. 24 | integer(kind=c_int), intent(in), value :: signum 25 | 26 | print '("Received SIGINT (", i0, "). Terminating ...")', signum 27 | stop 28 | end subroutine sigint_handler 29 | end program main 30 | -------------------------------------------------------------------------------- /examples/socket/socket.f90: -------------------------------------------------------------------------------- 1 | ! socket.f90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | program main 6 | !! Example program that connects to a TCP server using BSD sockets. On 7 | !! FreeBSD, start a local TCP server on port 8888 with netcat: 8 | !! 9 | !! ``` 10 | !! $ nc -l 8888 11 | !! ``` 12 | !! 13 | !! On Linux, run instead: 14 | !! 15 | !! ``` 16 | !! $ nc -l -p 8888 17 | !! ``` 18 | !! 19 | !! Then, execute the example: 20 | !! 21 | !! ``` 22 | !! $ ./socket 23 | !! ``` 24 | !! 25 | !! Enter 'PING' in netcat to receive a 'PONG' from the Fortran program. 26 | use, intrinsic :: iso_fortran_env, only: i8 => int64, stderr => error_unit, stdout => output_unit 27 | use :: unix 28 | implicit none 29 | 30 | character(len=*), parameter :: HOST = '127.0.0.1' ! IP address or FQDN. 31 | integer, parameter :: PORT = 8888 ! Port number. 32 | 33 | character(len=512), target :: buffer ! Input buffer. 34 | integer :: sock_fd ! Socket file descriptor. 35 | integer :: stat 36 | integer(kind=i8) :: nbytes 37 | 38 | ! Connect to TCP server. 39 | write (stdout, '("Connecting to ", a, ":", i0, " ...")') HOST, PORT 40 | sock_fd = socket_connect(HOST, PORT) 41 | 42 | if (sock_fd < 0) then 43 | write (stderr, '("Connection to server ", a, ":", i0, " failed")') HOST, PORT 44 | call c_perror('socket_connect()' // c_null_char) 45 | stop 46 | end if 47 | 48 | ! Write to socket. 49 | nbytes = socket_send(sock_fd, 'PING') 50 | 51 | do 52 | ! Read from socket. 53 | buffer = ' ' 54 | nbytes = c_read(sock_fd, c_loc(buffer), len(buffer, kind=i8)) 55 | 56 | ! Exit on error. 57 | if (nbytes <= 0) exit 58 | 59 | ! Print input buffer. 60 | write (stdout, '("<<< ", a)', advance='no') buffer(1:nbytes) 61 | 62 | ! Answer to `PING` with `PONG`. 63 | if (index(buffer, 'PING') > 0) then 64 | nbytes = socket_send(sock_fd, 'PONG') 65 | end if 66 | end do 67 | 68 | ! Close connection. 69 | stat = c_close(sock_fd) 70 | if (stat < 0) call c_perror('close()' // c_null_char) 71 | contains 72 | integer function socket_connect(host, port) result(fd) 73 | !! Creates a socket connection to `host`:`port`. The file descriptor 74 | !! of the socket is returned on success, the error code on failure. 75 | !! 76 | !! The source code has been adapted from the example listed at 77 | !! [https://man.openbsd.org/getaddrinfo.3](https://man.openbsd.org/getaddrinfo.3). 78 | character(len=*), intent(in) :: host 79 | integer, intent(in) :: port 80 | 81 | character(len=64), target :: host_str 82 | character(len=8), target :: port_str 83 | 84 | type(c_addrinfo), pointer :: next 85 | type(c_addrinfo), target :: hints 86 | type(c_addrinfo), target :: res 87 | 88 | character(len=:), allocatable :: err_str 89 | integer :: stat 90 | integer :: sock_fd 91 | type(c_ptr) :: ptr 92 | 93 | fd = -1 94 | 95 | host_str = trim(host) // c_null_char 96 | write (port_str, '(i0, a)') port, c_null_char 97 | 98 | ! Initialise derived type manually. 99 | hints%ai_family = AF_INET 100 | hints%ai_socktype = SOCK_STREAM 101 | 102 | ptr = c_loc(res) 103 | stat = c_getaddrinfo(node = c_loc(host_str), & 104 | service = c_loc(port_str), & 105 | hints = c_loc(hints), & 106 | res = ptr) 107 | 108 | ! Print error message of `c_getaddrinfo()`. 109 | if (stat /= 0) then 110 | ptr = c_gai_strerror(stat) 111 | call c_f_str_ptr(ptr, err_str) 112 | write (stderr, '("getaddrinfo() failed: ", a)') err_str 113 | return 114 | end if 115 | 116 | ! `c_getaddrinfo()` returns a list of address structures. 117 | ! Try each address until `c_connect()` is successful. 118 | call c_f_pointer(ptr, next) 119 | 120 | do while (associated(next)) 121 | sock_fd = c_socket(next%ai_family, next%ai_socktype, next%ai_protocol) 122 | 123 | if (sock_fd == -1) then 124 | ! Try next address. 125 | call c_f_pointer(next%ai_next, next) 126 | cycle 127 | end if 128 | 129 | if (sock_fd < -1) return 130 | 131 | stat = c_connect(sock_fd, next%ai_addr, next%ai_addrlen) 132 | 133 | if (stat == -1) then 134 | stat = c_close(sock_fd) 135 | return 136 | end if 137 | 138 | exit 139 | end do 140 | 141 | if (.not. associated(next)) then 142 | stat = c_close(sock_fd) 143 | return 144 | end if 145 | 146 | fd = sock_fd 147 | end function socket_connect 148 | 149 | integer(kind=i8) function socket_send(socket, str) result(nbytes) 150 | !! Writes given string to socket. 151 | character(len=*), parameter :: CR_LF = char(13) // char(10) 152 | 153 | integer, intent(in) :: socket 154 | character(len=*), intent(in) :: str 155 | 156 | character(len=:), allocatable, target :: buffer 157 | 158 | buffer = trim(str) // CR_LF 159 | nbytes = c_write(socket, c_loc(buffer), len(buffer, kind=c_size_t)) 160 | write (stdout, '(">>> ", a, " (", i0, " Byte)")') trim(str), nbytes 161 | end function socket_send 162 | end program main 163 | -------------------------------------------------------------------------------- /examples/stat/stat.f90: -------------------------------------------------------------------------------- 1 | ! stat.f90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | program main 6 | !! Example program for file status access. 7 | use :: unix 8 | implicit none 9 | 10 | character(len=*), parameter :: FILE_NAME = 'README.md' 11 | 12 | character(len=:), allocatable :: atime, mtime, ctime 13 | integer :: file_type, stat 14 | integer(kind=c_int64_t) :: file_mode 15 | type(c_stat_type) :: file_stat 16 | 17 | ! Get file status. 18 | stat = c_stat(FILE_NAME // c_null_char, file_stat) 19 | if (stat /= 0) error stop 20 | 21 | print '("File name........: ", a)', FILE_NAME 22 | print '("File size........: ", i0)', file_stat%st_size 23 | 24 | ! Get file type. 25 | file_mode = c_uint_to_int(file_stat%st_mode) 26 | file_type = int(iand(file_mode, int(S_IFMT, kind=c_int64_t))) 27 | 28 | write (*, '("File type........: ")', advance='no') 29 | 30 | select case (file_type) 31 | case (S_IFBLK) 32 | print '("block device")' 33 | case (S_IFCHR) 34 | print '("character device")' 35 | case (S_IFDIR) 36 | print '("directory")' 37 | case (S_IFIFO) 38 | print '("fifo")' 39 | case (S_IFLNK) 40 | print '("symlink")' 41 | case (S_IFREG) 42 | print '("file")' 43 | case (S_IFSOCK) 44 | print '("socket")' 45 | case default 46 | print '("unknown")' 47 | end select 48 | 49 | ! Get file times. 50 | call c_f_str_ptr(c_ctime(file_stat%st_atim%tv_sec), atime) 51 | call c_f_str_ptr(c_ctime(file_stat%st_mtim%tv_sec), mtime) 52 | call c_f_str_ptr(c_ctime(file_stat%st_ctim%tv_sec), ctime) 53 | 54 | print '("File access time.: ", a24)', atime 55 | print '("File modify time.: ", a24)', mtime 56 | print '("File changed time: ", a24)', ctime 57 | end program main 58 | -------------------------------------------------------------------------------- /examples/time/time.f90: -------------------------------------------------------------------------------- 1 | ! time.f90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | program main 6 | !! Example that calls POSIX time functions. 7 | use :: unix 8 | implicit none 9 | 10 | call timestamp() 11 | call strftime() 12 | call mktime() 13 | call asctime() 14 | call iso8601() 15 | contains 16 | subroutine asctime() 17 | !! Prints date and time string (of 2020-10-01 12:00:00). 18 | !! The C function `asctime()` returns a null-terminated string 19 | !! that is of the form `Thu Oct 1 12:00:00 2020\n`. 20 | character(len=:), allocatable :: str 21 | type(c_tm) :: tm 22 | type(c_ptr) :: ptr 23 | 24 | tm = c_tm(tm_sec = 0, & 25 | tm_min = 0, & 26 | tm_hour = 12, & 27 | tm_mday = 1, & 28 | tm_mon = 9, & 29 | tm_year = 2020 - 1900, & 30 | tm_wday = 4, & 31 | tm_yday = 0, & 32 | tm_isdst = 0) 33 | ptr = c_asctime(tm) 34 | 35 | call c_f_str_ptr(ptr, str) 36 | print '("Date and Time.: ", a)', str(1:24) 37 | end subroutine asctime 38 | 39 | subroutine iso8601() 40 | character(len=*), parameter :: FMT_ISO = & 41 | '(i0.4, 2("-", i0.2), "T", 2(i0.2, ":"), i0.2, ".", i0.6, sp, i0.2, ss, ":", i0.2)' 42 | 43 | character(len=32) :: iso 44 | 45 | integer :: stat 46 | integer :: year, month, day 47 | integer :: hour, minute, second, usecond 48 | integer :: zone_hour, zone_min 49 | 50 | type(c_ptr) :: ptr 51 | type(c_timeval) :: tv 52 | type(c_timezone) :: tz 53 | type(c_tm) :: tm 54 | 55 | stat = c_gettimeofday(tv, tz) 56 | ptr = c_localtime_r(tv%tv_sec, tm) 57 | 58 | year = tm%tm_year + 1900 59 | month = tm%tm_mon + 1 60 | day = tm%tm_mday 61 | hour = tm%tm_hour 62 | minute = tm%tm_min 63 | second = tm%tm_sec 64 | usecond = int(tv%tv_usec) 65 | 66 | zone_hour = int(tm%tm_gmtoff) / 3600 67 | zone_min = modulo(int(tm%tm_gmtoff) / 60, 60) 68 | 69 | write (iso, FMT_ISO) year, month, day, hour, minute, second, usecond, & 70 | zone_hour, zone_min 71 | print '("ISO 8601......: ", a)', iso 72 | end subroutine iso8601 73 | 74 | subroutine mktime() 75 | !! Prints UNIX timestamp. 76 | integer(kind=c_time_t) :: mk, ts 77 | type(c_ptr) :: ptr 78 | type(c_tm) :: tm 79 | 80 | ts = c_time(0_c_time_t) 81 | ptr = c_localtime_r(ts, tm) 82 | mk = c_mktime(tm) 83 | print '("UNIX Timestamp: ", i0)', mk 84 | end subroutine mktime 85 | 86 | subroutine strftime() 87 | !! Outputs date and time in ISO 8601. 88 | character(len=32) :: iso 89 | integer(kind=c_size_t) :: sz 90 | integer(kind=c_time_t) :: ts 91 | type(c_ptr) :: ptr 92 | type(c_tm) :: tm 93 | 94 | iso = ' ' 95 | ts = c_time(0_c_time_t) 96 | ptr = c_localtime_r(ts, tm) 97 | sz = c_strftime(iso, len(iso, kind=c_size_t), '%FT%T' // c_null_char, tm) 98 | print '("ISO 8601......: ", a)', iso 99 | end subroutine strftime 100 | 101 | subroutine timestamp() 102 | !! Prints UNIX timestamp. 103 | integer(kind=c_time_t) :: ts 104 | 105 | ts = c_time(0_c_time_t) 106 | print '("UNIX Timestamp: ", i0)', ts 107 | end subroutine timestamp 108 | end program main 109 | -------------------------------------------------------------------------------- /examples/uname/uname.f90: -------------------------------------------------------------------------------- 1 | ! uname.f90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | program main 6 | !! Example program that outputs uname information. 7 | use :: unix 8 | implicit none 9 | 10 | character(len=SYS_NMLN) :: sys_name 11 | character(len=SYS_NMLN) :: node_name 12 | character(len=SYS_NMLN) :: release 13 | character(len=SYS_NMLN) :: version 14 | character(len=SYS_NMLN) :: machine 15 | 16 | integer :: stat 17 | type(c_utsname) :: utsname 18 | 19 | stat = c_uname(utsname) 20 | if (stat /= 0) stop 'Error: uname() failed' 21 | 22 | call c_f_str_chars(utsname%sysname, sys_name) 23 | call c_f_str_chars(utsname%nodename, node_name) 24 | call c_f_str_chars(utsname%release, release) 25 | call c_f_str_chars(utsname%version, version) 26 | call c_f_str_chars(utsname%machine, machine) 27 | 28 | print '("OS name...: ", a)', trim(sys_name) 29 | print '("Node name.: ", a)', trim(node_name) 30 | print '("OS release: ", a)', trim(release) 31 | print '("OS version: ", a)', trim(version) 32 | print '("Platform..: ", a)', trim(machine) 33 | end program main 34 | -------------------------------------------------------------------------------- /examples/uptime/uptime.f90: -------------------------------------------------------------------------------- 1 | ! uptime.f90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | program main 6 | !! Prints system uptime to standard output, similar to uptime(1). 7 | use, intrinsic :: iso_fortran_env, only: i8 => int64 8 | use :: unix 9 | implicit none 10 | 11 | integer :: days, hrs, mins, secs 12 | integer(kind=i8) :: delta 13 | 14 | call system_uptime(delta) 15 | call time_delta_from_seconds(delta, days, hrs, mins, secs) 16 | 17 | print '(i0, " days ", i0, " hrs ", i0, " mins ", i0, " secs")', days, hrs, mins, secs 18 | contains 19 | subroutine system_uptime(time) 20 | integer(kind=i8), intent(out) :: time 21 | 22 | type(c_timespec) :: tp 23 | 24 | time = 0_i8 25 | if (c_clock_gettime(CLOCK_MONOTONIC, tp) /= 0) return 26 | time = tp%tv_sec 27 | if (time > 60) time = time + 30 28 | end subroutine system_uptime 29 | 30 | elemental subroutine time_delta_from_seconds(delta, days, hrs, mins, secs) 31 | integer(kind=i8), intent(out) :: delta 32 | integer, intent(out) :: days 33 | integer, intent(out) :: hrs 34 | integer, intent(out) :: mins 35 | integer, intent(out) :: secs 36 | 37 | integer(kind=i8) :: t 38 | 39 | t = delta 40 | days = int(t / 86400) 41 | t = modulo(t, 86400_i8) 42 | hrs = int(t / 3600) 43 | t = modulo(t, 3600_i8) 44 | mins = int(t / 60) 45 | secs = int(modulo(t, 60_i8)) 46 | end subroutine time_delta_from_seconds 47 | end program main 48 | -------------------------------------------------------------------------------- /ford.md: -------------------------------------------------------------------------------- 1 | project: fortran-unix 2 | version: 0.2.0 3 | license: isc 4 | doc_license: by 5 | graph: false 6 | search: true 7 | display: public 8 | sort: alpha 9 | fpp_extensions: F90 10 | macro: __linux__ 11 | preprocess: true 12 | summary: **fortran-unix** – A collection of Fortran 2008 ISO C binding 13 | interfaces to selected POSIX and SysV types, functions, and 14 | routines on 64-bit Linux and FreeBSD. 15 | author: Philipp Engel 16 | project_github: https://github.com/interkosmos/fortran-unix 17 | 18 | The library covers system calls for: 19 | 20 | * standard input/output, 21 | * file and directory access, 22 | * clocks and timers, 23 | * signals, 24 | * processes, 25 | * pipes, 26 | * serial port input/output, 27 | * terminal control, 28 | * POSIX threads, 29 | * POSIX mutexes and semaphores, 30 | * POSIX regular expressions, 31 | * BSD sockets, 32 | * UNIX System V message queues, 33 | * POSIX message queues. 34 | 35 | By default, the documentation is based on the Linux API. For the FreeBSD API, 36 | select build target `freebsd_doc`: 37 | 38 | ``` 39 | $ make freebsd_doc 40 | ``` 41 | 42 | ## Build Instructions 43 | 44 | On Linux, run: 45 | 46 | ``` 47 | $ make linux 48 | ``` 49 | 50 | On FreeBSD, run: 51 | 52 | ``` 53 | $ make freebsd 54 | ``` 55 | 56 | To compile with Intel oneAPI instead of GCC: 57 | 58 | ``` 59 | $ make CC=icx FC=ifx PPFLAGS= 60 | ``` 61 | 62 | Optionally, install `libfortran-unix.a` and the associated module files 63 | system-wide: 64 | 65 | ``` 66 | $ make install PREFIX=/opt 67 | --- Installing libfortran-unix.a to /opt/lib/ ... 68 | --- Installing module files to /opt/include/libfortran-unix/ ... 69 | ``` 70 | 71 | ## Fortran Package Manager 72 | 73 | Using the Fortran Package Manager, a preprocessor flag has to be passed to GNU 74 | Fortran. On Linux: 75 | 76 | ``` 77 | $ fpm build --profile release --flag "-D__linux__" 78 | ``` 79 | 80 | On FreeBSD: 81 | 82 | ``` 83 | $ fpm build --profile release --flag "-D__FreeBSD__" 84 | ``` 85 | -------------------------------------------------------------------------------- /fpm.toml: -------------------------------------------------------------------------------- 1 | name = "fortran-unix" 2 | version = "0.2.0" 3 | license = "ISC" 4 | author = "Philipp Engel" 5 | maintainer = "@interkosmos" 6 | copyright = "Copyright (c) 2022, Philipp Engel" 7 | description = "Fortran 2018 ISO C binding interfaces to SysV/POSIX" 8 | keywords = [ "posix", "sysv", "system", "unix", "linux", "freebsd" ] 9 | 10 | [library] 11 | source-dir = "src" 12 | 13 | [install] 14 | library = true 15 | 16 | [[example]] 17 | name = "dirent" 18 | source-dir = "examples/dirent" 19 | main = "dirent.f90" 20 | 21 | [[example]] 22 | name = "fifo" 23 | source-dir = "examples/fifo" 24 | main = "fifo.f90" 25 | 26 | [[example]] 27 | name = "fork" 28 | source-dir = "examples/fork" 29 | main = "fork.f90" 30 | 31 | [[example]] 32 | name = "irc" 33 | source-dir = "examples/irc" 34 | main = "irc.f90" 35 | 36 | [[example]] 37 | name = "key" 38 | source-dir = "examples/key" 39 | main = "key.f90" 40 | 41 | [[example]] 42 | name = "mqueue" 43 | source-dir = "examples/mqueue" 44 | main = "mqueue.f90" 45 | link = "rt" 46 | 47 | [[example]] 48 | name = "msg" 49 | source-dir = "examples/msg" 50 | main = "msg.f90" 51 | 52 | [[example]] 53 | name = "mutex" 54 | source-dir = "examples/mutex" 55 | main = "mutex.f90" 56 | link = "pthread" 57 | 58 | [[example]] 59 | name = "os" 60 | source-dir = "examples/os" 61 | main = "os.F90" 62 | 63 | [[example]] 64 | name = "pid" 65 | source-dir = "examples/pid" 66 | main = "pid.f90" 67 | 68 | [[example]] 69 | name = "pipe" 70 | source-dir = "examples/pipe" 71 | main = "pipe.f90" 72 | 73 | [[example]] 74 | name = "pthread" 75 | source-dir = "examples/pthread" 76 | main = "pthread.f90" 77 | link = "pthread" 78 | 79 | [[example]] 80 | name = "regex" 81 | source-dir = "examples/regex" 82 | main = "regex.f90" 83 | 84 | [[example]] 85 | name = "semaphore" 86 | source-dir = "examples/semaphore" 87 | main = "semaphore.f90" 88 | link = "pthread" 89 | 90 | [[example]] 91 | name = "serial" 92 | source-dir = "examples/serial" 93 | main = "serial.f90" 94 | 95 | [[example]] 96 | name = "signal" 97 | source-dir = "examples/signal" 98 | main = "signal.f90" 99 | 100 | [[example]] 101 | name = "socket" 102 | source-dir = "examples/socket" 103 | main = "socket.f90" 104 | 105 | [[example]] 106 | name = "stat" 107 | source-dir = "examples/stat" 108 | main = "stat.f90" 109 | 110 | [[example]] 111 | name = "time" 112 | source-dir = "examples/time" 113 | main = "time.f90" 114 | 115 | [[example]] 116 | name = "uname" 117 | source-dir = "examples/uname" 118 | main = "uname.f90" 119 | 120 | [[example]] 121 | name = "uptime" 122 | source-dir = "examples/uptime" 123 | main = "uptime.f90" 124 | -------------------------------------------------------------------------------- /src/unix.f90: -------------------------------------------------------------------------------- 1 | ! unix.f90 2 | ! 3 | ! A collection of Fortran 2008 ISO C binding interfaces to selected POSIX and 4 | ! SysV routines on 64-bit Unix-like operating systems. 5 | ! 6 | ! Author: Philipp Engel 7 | ! Licence: ISC 8 | module unix 9 | use, intrinsic :: iso_c_binding 10 | use :: unix_dirent 11 | use :: unix_errno 12 | use :: unix_fcntl 13 | use :: unix_inet 14 | use :: unix_ipc 15 | use :: unix_ioctl 16 | use :: unix_mqueue 17 | use :: unix_msg 18 | use :: unix_netdb 19 | use :: unix_pthread 20 | use :: unix_regex 21 | use :: unix_semaphore 22 | use :: unix_signal 23 | use :: unix_socket 24 | use :: unix_stat 25 | use :: unix_stdio 26 | use :: unix_stdlib 27 | use :: unix_string 28 | use :: unix_syslog 29 | use :: unix_termios 30 | use :: unix_time 31 | use :: unix_types 32 | use :: unix_unistd 33 | use :: unix_utsname 34 | use :: unix_wait 35 | implicit none 36 | 37 | interface c_int_to_uint 38 | !! Converts signed integer to unsigned integer. 39 | module procedure :: c_int32_to_uint16 40 | module procedure :: c_int64_to_uint32 41 | end interface 42 | 43 | interface c_uint_to_int 44 | !! Converts unsigned integer to signed integer. 45 | module procedure :: c_uint16_to_int32 46 | module procedure :: c_uint32_to_int64 47 | end interface 48 | 49 | public :: c_f_str_chars 50 | public :: c_f_str_ptr 51 | public :: c_int32_to_uint16 52 | public :: c_int64_to_uint32 53 | public :: c_int_to_uint 54 | public :: c_uint16_to_int32 55 | public :: c_uint32_to_int64 56 | public :: c_uint_to_int 57 | public :: f_c_str_chars 58 | public :: f_readdir 59 | public :: f_strerror 60 | contains 61 | pure elemental function c_int32_to_uint16(s) result(u) 62 | !! Converts signed `c_int32_t` integer to unsigned `c_uint16_t` integer. 63 | integer(kind=c_int32_t), intent(in) :: s !! Signed integer. 64 | integer(kind=c_uint16_t) :: u !! Unsigned integer. 65 | 66 | integer(kind=c_int32_t) :: i 67 | 68 | i = modulo(s, 65536_c_int32_t) 69 | 70 | if (i < 32768_c_int32_t) then 71 | u = int(i, kind=c_uint16_t) 72 | else 73 | u = int(i - 65536_c_int32_t, kind=c_uint16_t) 74 | end if 75 | end function c_int32_to_uint16 76 | 77 | pure elemental function c_int64_to_uint32(s) result(u) 78 | !! Converts signed `c_int64_t` integer to unsigned `c_uint32_t` integer. 79 | integer(kind=c_int64_t), intent(in) :: s !! Signed integer. 80 | integer(kind=c_uint32_t) :: u !! Unsigned integer. 81 | 82 | integer(kind=c_int64_t) :: i 83 | 84 | i = modulo(s, 4294967296_c_int64_t) 85 | 86 | if (i < 2147483648_c_int64_t) then 87 | u = int(i, kind=c_uint32_t) 88 | else 89 | u = int(i - 4294967296_c_int64_t, kind=c_uint32_t) 90 | end if 91 | end function c_int64_to_uint32 92 | 93 | pure elemental function c_uint16_to_int32(u) result(s) 94 | !! Converts unsigned `uint16_t` integer to signed `int32_t` integer. 95 | integer(kind=c_uint16_t), intent(in) :: u !! Unsigned integer. 96 | integer(kind=c_int32_t) :: s !! Signed integer. 97 | 98 | if (u >= 0) then 99 | s = int(u, kind=c_int32_t) 100 | else 101 | s = 65536_c_int32_t + int(u, kind=c_int32_t) 102 | end if 103 | end function c_uint16_to_int32 104 | 105 | pure elemental function c_uint32_to_int64(u) result(s) 106 | !! Converts unsigned `uint32_t` integer to signed `int64_t` integer. 107 | integer(kind=c_uint32_t), intent(in) :: u !! Unsigned integer. 108 | integer(kind=c_int64_t) :: s !! Signed integer. 109 | 110 | if (u >= 0) then 111 | s = int(u, kind=c_int64_t) 112 | else 113 | s = 4294967296_c_int64_t + int(u, kind=c_int64_t) 114 | end if 115 | end function c_uint32_to_int64 116 | 117 | function f_readdir(dirp) 118 | !! Wrapper function that calls `c_readdir()` and converts the returned 119 | !! C pointer to Fortran pointer. 120 | type(c_ptr), intent(in) :: dirp 121 | 122 | type(c_dirent), pointer :: f_readdir 123 | type(c_ptr) :: ptr 124 | 125 | f_readdir => null() 126 | ptr = c_readdir(dirp) 127 | if (.not. c_associated(ptr)) return 128 | call c_f_pointer(ptr, f_readdir) 129 | end function f_readdir 130 | 131 | function f_strerror(errnum) result(str) 132 | !! Wrapper function for `c_strerr()` that converts the returned C char 133 | !! array pointer to Fortran string. 134 | integer, intent(in) :: errnum 135 | character(len=:), allocatable :: str 136 | 137 | type(c_ptr) :: ptr 138 | 139 | ptr = c_strerror(errnum) 140 | call c_f_str_ptr(ptr, str) 141 | end function f_strerror 142 | 143 | subroutine c_f_str_chars(c_str, f_str) 144 | !! Copies a C string, passed as a C char array, to a Fortran string. 145 | character(kind=c_char), intent(inout) :: c_str(:) 146 | character(len=size(c_str)), intent(out) :: f_str 147 | 148 | integer :: i 149 | 150 | f_str = ' ' 151 | 152 | do i = 1, size(c_str) 153 | if (c_str(i) == c_null_char) exit 154 | f_str(i:i) = c_str(i) 155 | end do 156 | end subroutine c_f_str_chars 157 | 158 | subroutine c_f_str_ptr(c_str, f_str) 159 | !! Copies a C string, passed as a C pointer, to a Fortran string. 160 | type(c_ptr), intent(in) :: c_str 161 | character(len=:), allocatable, intent(out) :: f_str 162 | 163 | character(kind=c_char), pointer :: ptrs(:) 164 | integer(kind=c_size_t) :: i, sz 165 | 166 | copy_block: block 167 | if (.not. c_associated(c_str)) exit copy_block 168 | sz = c_strlen(c_str) 169 | if (sz < 0) exit copy_block 170 | call c_f_pointer(c_str, ptrs, [ sz ]) 171 | allocate (character(len=sz) :: f_str) 172 | 173 | do i = 1, sz 174 | f_str(i:i) = ptrs(i) 175 | end do 176 | 177 | return 178 | end block copy_block 179 | 180 | if (.not. allocated(f_str)) f_str = '' 181 | end subroutine c_f_str_ptr 182 | 183 | subroutine f_c_str_chars(f_str, c_str) 184 | !! Copies a Fortran string to a C char array. 185 | character(len=*), intent(in) :: f_str 186 | character(kind=c_char), intent(out) :: c_str(len(f_str)) 187 | 188 | integer :: i 189 | 190 | c_str = c_null_char 191 | 192 | do i = 1, len(f_str) 193 | c_str(i) = f_str(i:i) 194 | end do 195 | end subroutine f_c_str_chars 196 | end module unix 197 | -------------------------------------------------------------------------------- /src/unix_dirent.F90: -------------------------------------------------------------------------------- 1 | ! unix_dirent.F90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | module unix_dirent 6 | use, intrinsic :: iso_c_binding 7 | implicit none 8 | private 9 | 10 | integer(kind=c_int), parameter, public :: DT_UNKNOWN = 0 11 | integer(kind=c_int), parameter, public :: DT_FIFO = 1 12 | integer(kind=c_int), parameter, public :: DT_CHR = 2 13 | integer(kind=c_int), parameter, public :: DT_DIR = 4 14 | integer(kind=c_int), parameter, public :: DT_BLK = 6 15 | integer(kind=c_int), parameter, public :: DT_REG = 8 16 | integer(kind=c_int), parameter, public :: DT_LNK = 10 17 | integer(kind=c_int), parameter, public :: DT_SOCK = 12 18 | integer(kind=c_int), parameter, public :: DT_WHT = 14 19 | 20 | #if defined (__linux__) 21 | 22 | ! struct dirent 23 | type, bind(c), public :: c_dirent 24 | integer(kind=c_int64_t) :: d_ino = 0_c_int64_t 25 | integer(kind=c_int64_t) :: d_off = 0_c_int64_t 26 | integer(kind=c_int16_t) :: d_reclen = 0_c_int16_t 27 | integer(kind=c_int8_t) :: d_type = 0_c_int8_t 28 | character(kind=c_char) :: d_name(0:255) = c_null_char 29 | end type c_dirent 30 | 31 | #elif defined (__FreeBSD__) 32 | 33 | ! struct dirent 34 | type, bind(c), public :: c_dirent 35 | integer(kind=c_int64_t) :: d_fileno = 0_c_int64_t 36 | integer(kind=c_int64_t) :: d_off = 0_c_int64_t 37 | integer(kind=c_int16_t) :: d_reclen = 0_c_int16_t 38 | integer(kind=c_int8_t) :: d_type = 0_c_int8_t 39 | integer(kind=c_int8_t) :: d_namlen = 0_c_int8_t 40 | integer(kind=c_int32_t), private :: d_pad0 = 0_c_int32_t 41 | character(kind=c_char) :: d_name(0:255) = c_null_char 42 | end type c_dirent 43 | 44 | #endif 45 | 46 | public :: c_closedir 47 | public :: c_opendir 48 | public :: c_readdir 49 | 50 | interface 51 | ! int closedir(DIR *dirp) 52 | function c_closedir(dirp) bind(c, name='closedir') 53 | import :: c_int, c_ptr 54 | implicit none 55 | type(c_ptr), intent(in), value :: dirp 56 | integer(kind=c_int) :: c_closedir 57 | end function c_closedir 58 | 59 | ! DIR *opendir(const char *filename) 60 | function c_opendir(filename) bind(c, name='opendir') 61 | import :: c_char, c_ptr 62 | implicit none 63 | character(kind=c_char), intent(in) :: filename 64 | type(c_ptr) :: c_opendir 65 | end function c_opendir 66 | 67 | ! struct dirent *readdir(DIR *dirp) 68 | function c_readdir(dirp) bind(c, name='readdir') 69 | import :: c_ptr 70 | implicit none 71 | type(c_ptr), intent(in), value :: dirp 72 | type(c_ptr) :: c_readdir 73 | end function c_readdir 74 | end interface 75 | end module unix_dirent 76 | -------------------------------------------------------------------------------- /src/unix_errno.F90: -------------------------------------------------------------------------------- 1 | ! unix_errno.F90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | module unix_errno 6 | use, intrinsic :: iso_c_binding 7 | implicit none 8 | 9 | #if defined (__linux__) 10 | 11 | integer(kind=c_int), parameter, public :: EPERM = 1 12 | integer(kind=c_int), parameter, public :: ENOENT = 2 13 | integer(kind=c_int), parameter, public :: ESRCH = 3 14 | integer(kind=c_int), parameter, public :: EINTR = 4 15 | integer(kind=c_int), parameter, public :: EIO = 5 16 | integer(kind=c_int), parameter, public :: ENXIO = 6 17 | integer(kind=c_int), parameter, public :: E2BIG = 7 18 | integer(kind=c_int), parameter, public :: ENOEXEC = 8 19 | integer(kind=c_int), parameter, public :: EBADF = 9 20 | integer(kind=c_int), parameter, public :: ECHILD = 10 21 | integer(kind=c_int), parameter, public :: EAGAIN = 11 22 | integer(kind=c_int), parameter, public :: ENOMEM = 12 23 | integer(kind=c_int), parameter, public :: EACCES = 13 24 | integer(kind=c_int), parameter, public :: EFAULT = 14 25 | integer(kind=c_int), parameter, public :: ENOTBLK = 15 26 | integer(kind=c_int), parameter, public :: EBUSY = 16 27 | integer(kind=c_int), parameter, public :: EEXIST = 17 28 | integer(kind=c_int), parameter, public :: EXDEV = 18 29 | integer(kind=c_int), parameter, public :: ENODEV = 19 30 | integer(kind=c_int), parameter, public :: ENOTDIR = 20 31 | integer(kind=c_int), parameter, public :: EISDIR = 21 32 | integer(kind=c_int), parameter, public :: EINVAL = 22 33 | integer(kind=c_int), parameter, public :: ENFILE = 23 34 | integer(kind=c_int), parameter, public :: EMFILE = 24 35 | integer(kind=c_int), parameter, public :: ENOTTY = 25 36 | integer(kind=c_int), parameter, public :: ETXTBSY = 26 37 | integer(kind=c_int), parameter, public :: EFBIG = 27 38 | integer(kind=c_int), parameter, public :: ENOSPC = 28 39 | integer(kind=c_int), parameter, public :: ESPIPE = 29 40 | integer(kind=c_int), parameter, public :: EROFS = 30 41 | integer(kind=c_int), parameter, public :: EMLINK = 31 42 | integer(kind=c_int), parameter, public :: EPIPE = 32 43 | integer(kind=c_int), parameter, public :: EDOM = 33 44 | integer(kind=c_int), parameter, public :: ERANGE = 34 45 | integer(kind=c_int), parameter, public :: EDEADLK = 35 46 | integer(kind=c_int), parameter, public :: ENAMETOOLONG = 36 47 | integer(kind=c_int), parameter, public :: ENOLCK = 37 48 | integer(kind=c_int), parameter, public :: ENOSYS = 38 49 | integer(kind=c_int), parameter, public :: ENOTEMPTY = 39 50 | integer(kind=c_int), parameter, public :: ELOOP = 40 51 | integer(kind=c_int), parameter, public :: EWOULDBLOCK = EAGAIN 52 | integer(kind=c_int), parameter, public :: ENOMSG = 42 53 | integer(kind=c_int), parameter, public :: EIDRM = 43 54 | integer(kind=c_int), parameter, public :: ECHRNG = 44 55 | integer(kind=c_int), parameter, public :: EL2NSYNC = 45 56 | integer(kind=c_int), parameter, public :: EL3HLT = 46 57 | integer(kind=c_int), parameter, public :: EL3RST = 47 58 | integer(kind=c_int), parameter, public :: ELNRNG = 48 59 | integer(kind=c_int), parameter, public :: EUNATCH = 49 60 | integer(kind=c_int), parameter, public :: ENOCSI = 50 61 | integer(kind=c_int), parameter, public :: EL2HLT = 51 62 | integer(kind=c_int), parameter, public :: EBADE = 52 63 | integer(kind=c_int), parameter, public :: EBADR = 53 64 | integer(kind=c_int), parameter, public :: EXFULL = 54 65 | integer(kind=c_int), parameter, public :: ENOANO = 55 66 | integer(kind=c_int), parameter, public :: EBADRQC = 56 67 | integer(kind=c_int), parameter, public :: EBADSLT = 57 68 | integer(kind=c_int), parameter, public :: EDEADLOCK = EDEADLK 69 | integer(kind=c_int), parameter, public :: EBFONT = 59 70 | integer(kind=c_int), parameter, public :: ENOSTR = 60 71 | integer(kind=c_int), parameter, public :: ENODATA = 61 72 | integer(kind=c_int), parameter, public :: ETIME = 62 73 | integer(kind=c_int), parameter, public :: ENOSR = 63 74 | integer(kind=c_int), parameter, public :: ENONET = 64 75 | integer(kind=c_int), parameter, public :: ENOPKG = 65 76 | integer(kind=c_int), parameter, public :: EREMOTE = 66 77 | integer(kind=c_int), parameter, public :: ENOLINK = 67 78 | integer(kind=c_int), parameter, public :: EADV = 68 79 | integer(kind=c_int), parameter, public :: ESRMNT = 69 80 | integer(kind=c_int), parameter, public :: ECOMM = 70 81 | integer(kind=c_int), parameter, public :: EPROTO = 71 82 | integer(kind=c_int), parameter, public :: EMULTIHOP = 72 83 | integer(kind=c_int), parameter, public :: EDOTDOT = 73 84 | integer(kind=c_int), parameter, public :: EBADMSG = 74 85 | integer(kind=c_int), parameter, public :: EOVERFLOW = 75 86 | integer(kind=c_int), parameter, public :: ENOTUNIQ = 76 87 | integer(kind=c_int), parameter, public :: EBADFD = 77 88 | integer(kind=c_int), parameter, public :: EREMCHG = 78 89 | integer(kind=c_int), parameter, public :: ELIBACC = 79 90 | integer(kind=c_int), parameter, public :: ELIBBAD = 80 91 | integer(kind=c_int), parameter, public :: ELIBSCN = 81 92 | integer(kind=c_int), parameter, public :: ELIBMAX = 82 93 | integer(kind=c_int), parameter, public :: ELIBEXEC = 83 94 | integer(kind=c_int), parameter, public :: EILSEQ = 84 95 | integer(kind=c_int), parameter, public :: ERESTART = 85 96 | integer(kind=c_int), parameter, public :: ESTRPIPE = 86 97 | integer(kind=c_int), parameter, public :: EUSERS = 87 98 | integer(kind=c_int), parameter, public :: ENOTSOCK = 88 99 | integer(kind=c_int), parameter, public :: EDESTADDRREQ = 89 100 | integer(kind=c_int), parameter, public :: EMSGSIZE = 90 101 | integer(kind=c_int), parameter, public :: EPROTOTYPE = 91 102 | integer(kind=c_int), parameter, public :: ENOPROTOOPT = 92 103 | integer(kind=c_int), parameter, public :: EPROTONOSUPPORT = 93 104 | integer(kind=c_int), parameter, public :: ESOCKTNOSUPPORT = 94 105 | integer(kind=c_int), parameter, public :: EOPNOTSUPP = 95 106 | integer(kind=c_int), parameter, public :: EPFNOSUPPORT = 96 107 | integer(kind=c_int), parameter, public :: EAFNOSUPPORT = 97 108 | integer(kind=c_int), parameter, public :: EADDRINUSE = 98 109 | integer(kind=c_int), parameter, public :: EADDRNOTAVAIL = 99 110 | integer(kind=c_int), parameter, public :: ENETDOWN = 100 111 | integer(kind=c_int), parameter, public :: ENETUNREACH = 101 112 | integer(kind=c_int), parameter, public :: ENETRESET = 102 113 | integer(kind=c_int), parameter, public :: ECONNABORTED = 103 114 | integer(kind=c_int), parameter, public :: ECONNRESET = 104 115 | integer(kind=c_int), parameter, public :: ENOBUFS = 105 116 | integer(kind=c_int), parameter, public :: EISCONN = 106 117 | integer(kind=c_int), parameter, public :: ENOTCONN = 107 118 | integer(kind=c_int), parameter, public :: ESHUTDOWN = 108 119 | integer(kind=c_int), parameter, public :: ETOOMANYREFS = 109 120 | integer(kind=c_int), parameter, public :: ETIMEDOUT = 110 121 | integer(kind=c_int), parameter, public :: ECONNREFUSED = 111 122 | integer(kind=c_int), parameter, public :: EHOSTDOWN = 112 123 | integer(kind=c_int), parameter, public :: EHOSTUNREACH = 113 124 | integer(kind=c_int), parameter, public :: EALREADY = 114 125 | integer(kind=c_int), parameter, public :: EINPROGRESS = 115 126 | integer(kind=c_int), parameter, public :: ESTALE = 116 127 | integer(kind=c_int), parameter, public :: EUCLEAN = 117 128 | integer(kind=c_int), parameter, public :: ENOTNAM = 118 129 | integer(kind=c_int), parameter, public :: ENAVAIL = 119 130 | integer(kind=c_int), parameter, public :: EISNAM = 120 131 | integer(kind=c_int), parameter, public :: EREMOTEIO = 121 132 | integer(kind=c_int), parameter, public :: EDQUOT = 122 133 | integer(kind=c_int), parameter, public :: ENOMEDIUM = 123 134 | integer(kind=c_int), parameter, public :: EMEDIUMTYPE = 124 135 | integer(kind=c_int), parameter, public :: ECANCELED = 125 136 | integer(kind=c_int), parameter, public :: ENOKEY = 126 137 | integer(kind=c_int), parameter, public :: EKEYEXPIRED = 127 138 | integer(kind=c_int), parameter, public :: EKEYREVOKED = 128 139 | integer(kind=c_int), parameter, public :: EKEYREJECTED = 129 140 | integer(kind=c_int), parameter, public :: EOWNERDEAD = 130 141 | integer(kind=c_int), parameter, public :: ENOTRECOVERABLE = 131 142 | integer(kind=c_int), parameter, public :: ERFKILL = 132 143 | integer(kind=c_int), parameter, public :: EHWPOISON = 133 144 | 145 | #elif defined (__FreeBSD__) 146 | 147 | integer(kind=c_int), parameter, public :: EPERM = 1 148 | integer(kind=c_int), parameter, public :: ENOENT = 2 149 | integer(kind=c_int), parameter, public :: ESRCH = 3 150 | integer(kind=c_int), parameter, public :: EINTR = 4 151 | integer(kind=c_int), parameter, public :: EIO = 5 152 | integer(kind=c_int), parameter, public :: ENXIO = 6 153 | integer(kind=c_int), parameter, public :: E2BIG = 7 154 | integer(kind=c_int), parameter, public :: ENOEXEC = 8 155 | integer(kind=c_int), parameter, public :: EBADF = 9 156 | integer(kind=c_int), parameter, public :: ECHILD = 10 157 | integer(kind=c_int), parameter, public :: EDEADLK = 11 158 | integer(kind=c_int), parameter, public :: ENOMEM = 12 159 | integer(kind=c_int), parameter, public :: EACCES = 13 160 | integer(kind=c_int), parameter, public :: EFAULT = 14 161 | integer(kind=c_int), parameter, public :: ENOTBLK = 15 162 | integer(kind=c_int), parameter, public :: EBUSY = 16 163 | integer(kind=c_int), parameter, public :: EEXIST = 17 164 | integer(kind=c_int), parameter, public :: EXDEV = 18 165 | integer(kind=c_int), parameter, public :: ENODEV = 19 166 | integer(kind=c_int), parameter, public :: ENOTDIR = 20 167 | integer(kind=c_int), parameter, public :: EISDIR = 21 168 | integer(kind=c_int), parameter, public :: EINVAL = 22 169 | integer(kind=c_int), parameter, public :: ENFILE = 23 170 | integer(kind=c_int), parameter, public :: EMFILE = 24 171 | integer(kind=c_int), parameter, public :: ENOTTY = 25 172 | integer(kind=c_int), parameter, public :: ETXTBSY = 26 173 | integer(kind=c_int), parameter, public :: EFBIG = 27 174 | integer(kind=c_int), parameter, public :: ENOSPC = 28 175 | integer(kind=c_int), parameter, public :: ESPIPE = 29 176 | integer(kind=c_int), parameter, public :: EROFS = 30 177 | integer(kind=c_int), parameter, public :: EMLINK = 31 178 | integer(kind=c_int), parameter, public :: EPIPE = 32 179 | integer(kind=c_int), parameter, public :: EDOM = 33 180 | integer(kind=c_int), parameter, public :: ERANGE = 34 181 | integer(kind=c_int), parameter, public :: EAGAIN = 35 182 | integer(kind=c_int), parameter, public :: EWOULDBLOCK = EAGAIN 183 | integer(kind=c_int), parameter, public :: EINPROGRESS = 36 184 | integer(kind=c_int), parameter, public :: EALREADY = 37 185 | integer(kind=c_int), parameter, public :: ENOTSOCK = 38 186 | integer(kind=c_int), parameter, public :: EDESTADDRREQ = 39 187 | integer(kind=c_int), parameter, public :: EMSGSIZE = 40 188 | integer(kind=c_int), parameter, public :: EPROTOTYPE = 41 189 | integer(kind=c_int), parameter, public :: ENOPROTOOPT = 42 190 | integer(kind=c_int), parameter, public :: EPROTONOSUPPORT = 43 191 | integer(kind=c_int), parameter, public :: ESOCKTNOSUPPORT = 44 192 | integer(kind=c_int), parameter, public :: EOPNOTSUPP = 45 193 | integer(kind=c_int), parameter, public :: ENOTSUP = EOPNOTSUPP 194 | integer(kind=c_int), parameter, public :: EPFNOSUPPORT = 46 195 | integer(kind=c_int), parameter, public :: EAFNOSUPPORT = 47 196 | integer(kind=c_int), parameter, public :: EADDRINUSE = 48 197 | integer(kind=c_int), parameter, public :: EADDRNOTAVAIL = 49 198 | integer(kind=c_int), parameter, public :: ENETDOWN = 50 199 | integer(kind=c_int), parameter, public :: ENETUNREACH = 51 200 | integer(kind=c_int), parameter, public :: ENETRESET = 52 201 | integer(kind=c_int), parameter, public :: ECONNABORTED = 53 202 | integer(kind=c_int), parameter, public :: ECONNRESET = 54 203 | integer(kind=c_int), parameter, public :: ENOBUFS = 55 204 | integer(kind=c_int), parameter, public :: EISCONN = 56 205 | integer(kind=c_int), parameter, public :: ENOTCONN = 57 206 | integer(kind=c_int), parameter, public :: ESHUTDOWN = 58 207 | integer(kind=c_int), parameter, public :: ETOOMANYREFS = 59 208 | integer(kind=c_int), parameter, public :: ETIMEDOUT = 60 209 | integer(kind=c_int), parameter, public :: ECONNREFUSED = 61 210 | integer(kind=c_int), parameter, public :: ELOOP = 62 211 | integer(kind=c_int), parameter, public :: ENAMETOOLONG = 63 212 | integer(kind=c_int), parameter, public :: EHOSTDOWN = 64 213 | integer(kind=c_int), parameter, public :: EHOSTUNREACH = 65 214 | integer(kind=c_int), parameter, public :: ENOTEMPTY = 66 215 | integer(kind=c_int), parameter, public :: EPROCLIM = 67 216 | integer(kind=c_int), parameter, public :: EUSERS = 68 217 | integer(kind=c_int), parameter, public :: EDQUOT = 69 218 | 219 | #endif 220 | 221 | public :: c_errno 222 | 223 | ! Interface to `c_errno()` in `errno.c` 224 | interface 225 | ! int c_errno() 226 | function c_errno() bind(c, name='c_errno') 227 | import :: c_int 228 | implicit none 229 | integer(c_int) :: c_errno 230 | end function c_errno 231 | end interface 232 | end module unix_errno 233 | -------------------------------------------------------------------------------- /src/unix_fcntl.F90: -------------------------------------------------------------------------------- 1 | ! unix_fcntl.F90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | module unix_fcntl 6 | use, intrinsic :: iso_c_binding 7 | use :: unix_types 8 | implicit none 9 | private 10 | 11 | #if defined (__linux__) 12 | 13 | integer(kind=c_int), parameter, public :: AT_EACCESS = int(z'200') 14 | integer(kind=c_int), parameter, public :: AT_SYMLINK_NOFOLLOW = int(z'100') 15 | integer(kind=c_int), parameter, public :: AT_SYMLINK_FOLLOW = int(z'400') 16 | integer(kind=c_int), parameter, public :: AT_REMOVEDIR = int(z'200') 17 | integer(kind=c_int), parameter, public :: AT_EMPTY_PATH = int(z'1000') 18 | 19 | integer(kind=c_int), parameter, public :: O_ACCMODE = int(o'0003') 20 | integer(kind=c_int), parameter, public :: O_RDONLY = int(o'00') 21 | integer(kind=c_int), parameter, public :: O_WRONLY = int(o'01') 22 | integer(kind=c_int), parameter, public :: O_RDWR = int(o'02') 23 | integer(kind=c_int), parameter, public :: O_CREAT = int(o'0100') 24 | integer(kind=c_int), parameter, public :: O_EXCL = int(o'0200') 25 | integer(kind=c_int), parameter, public :: O_NOCTTY = int(o'0400') 26 | integer(kind=c_int), parameter, public :: O_TRUNC = int(o'01000') 27 | integer(kind=c_int), parameter, public :: O_APPEND = int(o'02000') 28 | integer(kind=c_int), parameter, public :: O_NONBLOCK = int(o'04000') 29 | integer(kind=c_int), parameter, public :: O_NDELAY = O_NONBLOCK 30 | integer(kind=c_int), parameter, public :: O_SYNC = int(o'04010000') 31 | integer(kind=c_int), parameter, public :: O_FSYNC = O_SYNC 32 | integer(kind=c_int), parameter, public :: O_ASYNC = int(o'020000') 33 | 34 | integer(kind=c_int), parameter, public :: O_CLOEXEC = int(o'02000000') 35 | 36 | #elif defined (__FreeBSD__) 37 | 38 | integer(kind=c_int), parameter, public :: AT_EACCESS = int(z'0100') ! Check access using effective user and group ID. 39 | integer(kind=c_int), parameter, public :: AT_SYMLINK_NOFOLLOW = int(z'0200') ! Do not follow symbolic links. 40 | integer(kind=c_int), parameter, public :: AT_SYMLINK_FOLLOW = int(z'0400') ! Follow symbolic link. 41 | integer(kind=c_int), parameter, public :: AT_REMOVEDIR = int(z'0800') ! Remove directory instead of file. 42 | integer(kind=c_int), parameter, public :: AT_EMPTY_PATH = int(z'4000') ! Operate on dirfd if path is empty. 43 | 44 | integer(kind=c_int), parameter, public :: O_RDONLY = int(z'0000') ! Open for reading only. 45 | integer(kind=c_int), parameter, public :: O_WRONLY = int(z'0001') ! Open for writing only. 46 | integer(kind=c_int), parameter, public :: O_RDWR = int(z'0002') ! Open for reading and writing. 47 | integer(kind=c_int), parameter, public :: O_ACCMODE = int(z'0003') ! Mask for above modes. 48 | integer(kind=c_int), parameter, public :: O_SYNC = int(z'0008') ! POSIX synonym for O_FSYNC. 49 | integer(kind=c_int), parameter, public :: O_CREAT = int(z'0200') ! Create if nonexistent. 50 | integer(kind=c_int), parameter, public :: O_TRUNC = int(z'0400') ! Truncate to zero length. 51 | integer(kind=c_int), parameter, public :: O_EXCL = int(z'0800') ! Error if already exists. 52 | integer(kind=c_int), parameter, public :: O_NONBLOCK = int(z'0004') ! No delay. 53 | integer(kind=c_int), parameter, public :: O_NDELAY = O_NONBLOCK 54 | integer(kind=c_int), parameter, public :: O_APPEND = int(z'0008') ! Set append mode. 55 | integer(kind=c_int), parameter, public :: O_NOCTTY = int(z'8000') ! Don't assign controlling terminal. 56 | 57 | integer(kind=c_int), parameter, public :: O_CLOEXEC = int(z'00100000') 58 | 59 | #endif 60 | 61 | integer(kind=c_int), parameter, public :: F_DUPFD = 0 ! Duplicate file descriptor. 62 | integer(kind=c_int), parameter, public :: F_GETFD = 1 ! Get file descriptor flags. 63 | integer(kind=c_int), parameter, public :: F_SETFD = 2 ! Set file descriptor flags. 64 | integer(kind=c_int), parameter, public :: F_GETFL = 3 ! Get file status flags. 65 | integer(kind=c_int), parameter, public :: F_SETFL = 4 ! Set file status flags. 66 | 67 | public :: c_fcntl 68 | public :: c_open 69 | 70 | interface 71 | ! int fcntl(int fd, int cmd, ...) 72 | function c_fcntl(fd, cmd, arg) bind(c, name='c_fcntl') 73 | import :: c_int, c_ptr 74 | implicit none 75 | integer(kind=c_int), intent(in), value :: fd 76 | integer(kind=c_int), intent(in), value :: cmd 77 | integer(kind=c_int), intent(in), value :: arg 78 | integer(kind=c_int) :: c_fcntl 79 | end function c_fcntl 80 | 81 | ! int open(const char *pathname, int flags, mode_t mode) 82 | function c_open(pathname, flags, mode) bind(c, name='c_open') 83 | import :: c_char, c_int, c_mode_t 84 | implicit none 85 | character(kind=c_char), intent(in) :: pathname 86 | integer(kind=c_int), intent(in), value :: flags 87 | integer(kind=c_mode_t), intent(in), value :: mode 88 | integer(kind=c_int) :: c_open 89 | end function c_open 90 | end interface 91 | end module unix_fcntl 92 | -------------------------------------------------------------------------------- /src/unix_inet.F90: -------------------------------------------------------------------------------- 1 | ! unix_inet.F90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | module unix_inet 6 | use, intrinsic :: iso_c_binding 7 | use :: unix_types 8 | implicit none 9 | private 10 | 11 | public :: c_htonl 12 | public :: c_htons 13 | public :: c_inet_addr 14 | 15 | interface 16 | ! uint32_t htonl(uint32_t host) 17 | function c_htonl(host) bind(c, name='htonl') 18 | import :: c_uint32_t 19 | implicit none 20 | integer(kind=c_uint32_t), intent(in), value :: host 21 | integer(kind=c_uint32_t) :: c_htonl 22 | end function c_htonl 23 | 24 | ! uint16_t htons(uint16_t host) 25 | function c_htons(host) bind(c, name='htons') 26 | import :: c_uint16_t 27 | implicit none 28 | integer(kind=c_uint16_t), intent(in), value :: host 29 | integer(kind=c_uint16_t) :: c_htons 30 | end function c_htons 31 | 32 | ! in_addr_t inet_addr(const char *cp) 33 | function c_inet_addr(cp) bind(c, name='inet_addr') 34 | import :: c_char, c_in_addr_t 35 | implicit none 36 | character(kind=c_char), intent(in) :: cp 37 | integer(kind=c_in_addr_t) :: c_inet_addr 38 | end function c_inet_addr 39 | end interface 40 | end module unix_inet 41 | -------------------------------------------------------------------------------- /src/unix_ioctl.F90: -------------------------------------------------------------------------------- 1 | ! unix_ioctl.F90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | module unix_ioctl 6 | use, intrinsic :: iso_c_binding 7 | use :: unix_types 8 | implicit none 9 | private 10 | 11 | public :: c_ioctl 12 | 13 | interface 14 | ! int c_ioctl(int fd, unsigned long request, void *arg) 15 | function c_ioctl(fd, request, arg) bind(c, name='c_ioctl') 16 | import :: c_int, c_ptr, c_unsigned_long 17 | implicit none 18 | integer(kind=c_int), intent(in), value :: fd 19 | integer(kind=c_unsigned_long), intent(in), value :: request 20 | type(c_ptr), intent(in), value :: arg 21 | integer(kind=c_int) :: c_ioctl 22 | end function c_ioctl 23 | end interface 24 | end module unix_ioctl 25 | -------------------------------------------------------------------------------- /src/unix_ipc.F90: -------------------------------------------------------------------------------- 1 | ! unix_ipc.F90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | module unix_ipc 6 | use, intrinsic :: iso_c_binding 7 | use :: unix_types 8 | implicit none 9 | private 10 | 11 | integer(kind=c_int), parameter, public :: IPC_CREAT = int(o'001000') 12 | integer(kind=c_int), parameter, public :: IPC_EXCL = int(o'002000') 13 | integer(kind=c_int), parameter, public :: IPC_NOWAIT = int(o'004000') 14 | 15 | integer(kind=c_int), parameter, public :: IPC_RMID = 0 16 | integer(kind=c_int), parameter, public :: IPC_SET = 1 17 | integer(kind=c_int), parameter, public :: IPC_STAT = 2 18 | 19 | integer(kind=c_key_t), parameter, public :: IPC_PRIVATE = 0 20 | 21 | public :: c_ftok 22 | 23 | interface 24 | ! key_t ftok(const char *pathname, int proj_id) 25 | function c_ftok(pathname, proj_id) bind(c, name='ftok') 26 | import :: c_char, c_int, c_key_t 27 | implicit none 28 | character(kind=c_char), intent(in) :: pathname 29 | integer(kind=c_int), intent(in), value :: proj_id 30 | integer(kind=c_key_t) :: c_ftok 31 | end function c_ftok 32 | end interface 33 | end module unix_ipc 34 | -------------------------------------------------------------------------------- /src/unix_macro.c: -------------------------------------------------------------------------------- 1 | /* unix_macro.c */ 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | 10 | #ifdef __cplusplus 11 | extern "C" { 12 | #endif 13 | 14 | int c_errno(void); 15 | int c_execl(const char *, const char *, const char *, const char *, void *); 16 | int c_fcntl(int, int, int); 17 | int c_fprintf(FILE *, const char *, const char *); 18 | int c_ioctl(int, unsigned long, void *); 19 | int c_open(const char *, int, mode_t); 20 | int c_scanf(const char *, const char *); 21 | int c_uname(struct utsname *); 22 | void c_syslog(int, const char *, const char *); 23 | 24 | /******************************************************************************* 25 | *** Macro replacements. *** 26 | *******************************************************************************/ 27 | 28 | /* Returns variable `errno` from `errno.h`. */ 29 | int c_errno(void) 30 | { 31 | return errno; 32 | } 33 | 34 | /******************************************************************************* 35 | *** Non-variadic and other wrapper procedures. *** 36 | *******************************************************************************/ 37 | 38 | /* int execl(const char *path, const char *arg, ...) */ 39 | int c_execl(const char *path, const char *arg1, const char *arg2, const char *arg3, void *ptr) 40 | { 41 | return execl(path, arg1, arg2, arg3, ptr, NULL); 42 | } 43 | 44 | /* int fcntl(int fd, int cmd, ...) */ 45 | int c_fcntl(int fd, int cmd, int arg) 46 | { 47 | return fcntl(fd, cmd, arg); 48 | } 49 | 50 | /* int fprintf(FILE *stream, const char *format, ...) */ 51 | int c_fprintf(FILE *stream, const char *format, const char *arg) 52 | { 53 | return fprintf(stream, format, arg); 54 | } 55 | 56 | /* int ioctl(int fd, unsigned long request, ...) */ 57 | int c_ioctl(int fd, unsigned long request, void *arg) 58 | { 59 | return ioctl(fd, request, arg); 60 | } 61 | 62 | /* int open(const char *pathname, int flags, ...) */ 63 | int c_open(const char *pathname, int flags, mode_t mode) 64 | { 65 | return open(pathname, flags, mode); 66 | } 67 | 68 | /* int scanf(const char *format, ...) */ 69 | int c_scanf(const char *format, const char *arg) 70 | { 71 | return scanf(format, arg); 72 | } 73 | 74 | /* int uname(struct utsname *name) */ 75 | int c_uname(struct utsname *name) 76 | { 77 | return uname(name); 78 | } 79 | 80 | /* void syslog(int priority, const char *format, ...) */ 81 | void c_syslog(int priority, const char *format, const char *arg) 82 | { 83 | syslog(priority, format, arg); 84 | } 85 | 86 | #ifdef __cplusplus 87 | } 88 | #endif 89 | -------------------------------------------------------------------------------- /src/unix_mqueue.F90: -------------------------------------------------------------------------------- 1 | ! unix_mqueues.F90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | module unix_mqueue 6 | use, intrinsic :: iso_c_binding 7 | use :: unix_time 8 | use :: unix_types 9 | implicit none 10 | private 11 | 12 | ! struct mq_attr 13 | type, bind(c), public :: c_mq_attr 14 | integer(kind=c_long) :: mq_flags = 0_c_long ! Flags (ignored for mq_open()). 15 | integer(kind=c_long) :: mq_maxmsg = 0_c_long ! Max. # of messages on queue. 16 | integer(kind=c_long) :: mq_msgsize = 0_c_long ! Max. message size (bytes). 17 | integer(kind=c_long) :: mq_curmsgs = 0_c_long ! # of messages currently in queue. 18 | integer(kind=c_long), private :: reserved(4) = 0_c_long 19 | end type c_mq_attr 20 | 21 | public :: c_mq_close 22 | public :: c_mq_getattr 23 | public :: c_mq_open 24 | public :: c_mq_receive 25 | public :: c_mq_send 26 | public :: c_mq_setattr 27 | public :: c_mq_timedreceive 28 | public :: c_mq_unlink 29 | 30 | interface 31 | ! int mq_close(mqd_t mqdes) 32 | function c_mq_close(mqdes) bind(c, name='mq_close') 33 | import :: c_int, c_mqd_t 34 | implicit none 35 | integer(kind=c_mqd_t), intent(in), value :: mqdes 36 | integer(kind=c_int) :: c_mq_close 37 | end function c_mq_close 38 | 39 | ! int mq_getattr(mqd_t mqdes, struct mq_attr *attr) 40 | function c_mq_getattr(mqdes, attr) bind(c, name='mq_getattr') 41 | import :: c_int, c_mq_attr, c_mqd_t 42 | implicit none 43 | integer(kind=c_mqd_t), intent(in), value :: mqdes 44 | type(c_mq_attr), intent(out) :: attr 45 | integer(kind=c_int) :: c_mq_getattr 46 | end function c_mq_getattr 47 | 48 | ! mqd_t c_mq_open(const char *name, int oflag, mode_t mode, struct mq_attr *attr) 49 | function c_mq_open(name, oflag, mode, attr) bind(c, name='mq_open') 50 | import :: c_char, c_int, c_mode_t, c_mqd_t, c_ptr 51 | implicit none 52 | character(kind=c_char), intent(in) :: name 53 | integer(kind=c_int), intent(in), value :: oflag 54 | integer(kind=c_mode_t), intent(in), value :: mode 55 | type(c_ptr), intent(in), value :: attr 56 | integer(kind=c_mqd_t) :: c_mq_open 57 | end function c_mq_open 58 | 59 | ! ssize_t mq_receive(mqd_t mqdes, char *msg_ptr, size_t msg_len, unsigned int *msg_prio) 60 | function c_mq_receive(mqdes, msg_ptr, msg_len, msg_prio) bind(c, name='mq_receive') 61 | import :: c_char, c_mqd_t, c_size_t, c_unsigned 62 | implicit none 63 | integer(kind=c_mqd_t), intent(in), value :: mqdes 64 | character(kind=c_char), intent(in) :: msg_ptr 65 | integer(kind=c_size_t), intent(in), value :: msg_len 66 | integer(kind=c_unsigned), intent(out) :: msg_prio 67 | integer(kind=c_size_t) :: c_mq_receive 68 | end function c_mq_receive 69 | 70 | ! int mq_send(mqd_t mqdes, const char *msg_ptr, size_t msg_len, unsigned int msg_prio) 71 | function c_mq_send(mqdes, msg_ptr, msg_len, msg_prio) bind(c, name='mq_send') 72 | import :: c_char, c_int, c_mqd_t, c_size_t, c_unsigned 73 | implicit none 74 | integer(kind=c_mqd_t), intent(in), value :: mqdes 75 | character(kind=c_char), intent(in) :: msg_ptr 76 | integer(kind=c_size_t), intent(in), value :: msg_len 77 | integer(kind=c_unsigned), intent(in), value :: msg_prio 78 | integer(kind=c_int) :: c_mq_send 79 | end function c_mq_send 80 | 81 | ! int mq_setattr(mqd_t mqdes, const struct mq_attr *attr, struct mq_attr *oldattr) 82 | function c_mq_setattr(mqdes, attr, oldattr) bind(c, name='mq_setattr') 83 | import :: c_int, c_mq_attr, c_mqd_t, c_ptr 84 | implicit none 85 | integer(kind=c_mqd_t), intent(in), value :: mqdes 86 | type(c_mq_attr), intent(in) :: attr 87 | type(c_mq_attr), intent(out) :: oldattr 88 | integer(kind=c_int) :: c_mq_setattr 89 | end function c_mq_setattr 90 | 91 | ! ssize_t mq_timedreceive(mqd_t mqdes, char *msg_ptr, size_t msg_len, unsigned int *msg_prio, const struct timespec *abs_timeout) 92 | function c_mq_timedreceive(mqdes, msg_ptr, msg_len, msg_prio, abs_timeout) bind(c, name='mq_timedreceive') 93 | import :: c_char, c_mqd_t, c_size_t, c_timespec, c_unsigned 94 | implicit none 95 | integer(kind=c_mqd_t), intent(in), value :: mqdes 96 | character(kind=c_char), intent(in) :: msg_ptr 97 | integer(kind=c_size_t), intent(in), value :: msg_len 98 | integer(kind=c_unsigned), intent(out) :: msg_prio 99 | type(c_timespec), intent(in) :: abs_timeout 100 | integer(kind=c_size_t) :: c_mq_timedreceive 101 | end function c_mq_timedreceive 102 | 103 | ! int mq_unlink(const char *name) 104 | function c_mq_unlink(name) bind(c, name='mq_unlink') 105 | import :: c_char, c_int 106 | implicit none 107 | character(kind=c_char), intent(in) :: name 108 | integer(kind=c_int) :: c_mq_unlink 109 | end function c_mq_unlink 110 | end interface 111 | end module unix_mqueue 112 | -------------------------------------------------------------------------------- /src/unix_msg.F90: -------------------------------------------------------------------------------- 1 | ! unix_msg.F90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | module unix_msg 6 | use, intrinsic :: iso_c_binding 7 | use :: unix_types 8 | implicit none 9 | private 10 | 11 | public :: c_msgctl 12 | public :: c_msgget 13 | public :: c_msgrcv 14 | public :: c_msgsnd 15 | 16 | interface 17 | ! int msgctl(int msqid, int cmd, struct msqid_ds *buf) 18 | function c_msgctl(msqid, cmd, buf) bind(c, name='msgctl') 19 | import :: c_int, c_ptr 20 | implicit none 21 | integer(kind=c_int), intent(in), value :: msqid 22 | integer(kind=c_int), intent(in), value :: cmd 23 | type(c_ptr), intent(in), value :: buf 24 | integer(kind=c_int) :: c_msgctl 25 | end function c_msgctl 26 | 27 | ! int msgget(key_t key, int msgflg) 28 | function c_msgget(key, msgflg) bind(c, name='msgget') 29 | import :: c_int, c_key_t 30 | implicit none 31 | integer(kind=c_key_t), intent(in), value :: key 32 | integer(kind=c_int), intent(in), value :: msgflg 33 | integer(kind=c_int) :: c_msgget 34 | end function c_msgget 35 | 36 | ! ssize_t msgrcv(int msqid, void *msgp, size_t msgsz, long msgtyp, int msgflg) 37 | function c_msgrcv(msqid, msgp, msgsz, msgtyp, msgflg) bind(c, name='msgrcv') 38 | import :: c_int, c_long, c_ptr, c_size_t 39 | implicit none 40 | integer(kind=c_int), intent(in), value :: msqid 41 | type(c_ptr), intent(in), value :: msgp 42 | integer(kind=c_size_t), intent(in), value :: msgsz 43 | integer(kind=c_long) , intent(in), value :: msgtyp 44 | integer(kind=c_int), intent(in), value :: msgflg 45 | integer(kind=c_size_t) :: c_msgrcv 46 | end function c_msgrcv 47 | 48 | ! int msgsnd(int msqid, const void *msgp, size_t msgsz, int msgflg) 49 | function c_msgsnd(msqid, msgp, msgsz, msgflg) bind(c, name='msgsnd') 50 | import :: c_int, c_ptr, c_size_t 51 | implicit none 52 | integer(kind=c_int), intent(in), value :: msqid 53 | type(c_ptr), intent(in), value :: msgp 54 | integer(kind=c_size_t), intent(in), value :: msgsz 55 | integer(kind=c_int), intent(in), value :: msgflg 56 | integer(kind=c_int) :: c_msgsnd 57 | end function c_msgsnd 58 | end interface 59 | end module unix_msg 60 | -------------------------------------------------------------------------------- /src/unix_netdb.F90: -------------------------------------------------------------------------------- 1 | ! unix_netdb.F90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | module unix_netdb 6 | use, intrinsic :: iso_c_binding 7 | use :: unix_fcntl 8 | use :: unix_types 9 | implicit none 10 | private 11 | 12 | integer(kind=c_int), parameter, public :: AF_LOCAL = 1 13 | integer(kind=c_int), parameter, public :: AF_UNIX = 1 14 | integer(kind=c_int), parameter, public :: AF_INET = 2 15 | 16 | integer(kind=c_int), parameter, public :: SOCK_STREAM = 1 17 | integer(kind=c_int), parameter, public :: SOCK_DGRAM = 2 18 | integer(kind=c_int), parameter, public :: SOCK_RAW = 3 19 | integer(kind=c_int), parameter, public :: SOCK_RDM = 4 20 | integer(kind=c_int), parameter, public :: SOCK_SEQPACKET = 5 21 | 22 | integer(kind=c_int), parameter, public :: AI_PASSIVE = int(z'00000001') 23 | integer(kind=c_int), parameter, public :: AI_CANONNAME = int(z'00000002') 24 | integer(kind=c_int), parameter, public :: AI_NUMERICHOST = int(z'00000004') 25 | integer(kind=c_int), parameter, public :: AI_NUMERICSERV = int(z'00000008') 26 | 27 | integer(kind=c_in_addr_t), parameter, public :: INADDR_ANY = int(z'00000000') 28 | 29 | ! struct in_addr 30 | type, bind(c), public :: c_in_addr 31 | integer(kind=c_int32_t) :: s_addr = 0_c_int32_t 32 | end type c_in_addr 33 | 34 | #if defined (__linux__) 35 | 36 | integer(kind=c_int), parameter, public :: AF_INET6 = 10 37 | 38 | integer(kind=c_int), parameter, public :: SOCK_CLOEXEC = O_CLOEXEC 39 | integer(kind=c_int), parameter, public :: SOCK_NONBLOCK = O_NONBLOCK 40 | 41 | integer(kind=c_int), parameter, public :: c_sa_family_t = c_signed_char 42 | 43 | ! struct sockaddr 44 | type, bind(c), public :: c_sockaddr 45 | integer(kind=c_sa_family_t) :: sa_family = 0_c_sa_family_t 46 | character(kind=c_char) :: sa_data(0:13) = c_null_char 47 | end type c_sockaddr 48 | 49 | ! struct addrinfo 50 | type, bind(c), public :: c_addrinfo 51 | integer(kind=c_int) :: ai_flags = 0 52 | integer(kind=c_int) :: ai_family = 0 53 | integer(kind=c_int) :: ai_socktype = 0 54 | integer(kind=c_int) :: ai_protocol = 0 55 | integer(kind=c_socklen_t) :: ai_addrlen = 0_c_socklen_t 56 | type(c_ptr) :: ai_addr = c_null_ptr 57 | type(c_ptr) :: ai_canonname = c_null_ptr 58 | type(c_ptr) :: ai_next = c_null_ptr 59 | end type c_addrinfo 60 | 61 | ! struct sockaddr_in 62 | type, bind(c), public :: c_sockaddr_in 63 | integer(kind=c_sa_family_t) :: sin_family = 0_c_sa_family_t 64 | integer(kind=c_int16_t) :: sin_port = 0_c_int16_t 65 | type(c_in_addr) :: sin_addr 66 | end type c_sockaddr_in 67 | 68 | #elif defined (__FreeBSD__) 69 | 70 | integer(kind=c_int), parameter, public :: AF_INET6 = 28 71 | 72 | integer(kind=c_int), parameter, public :: SOCK_CLOEXEC = int(z'10000000') 73 | integer(kind=c_int), parameter, public :: SOCK_NONBLOCK = int(z'20000000') 74 | 75 | ! struct sockaddr 76 | type, bind(c), public :: c_sockaddr 77 | character(kind=c_char) :: sa_len = c_null_char 78 | integer(kind=c_int) :: sa_family = 0 79 | character(kind=c_char) :: sa_data(0:13) = c_null_char 80 | end type c_sockaddr 81 | 82 | ! struct addrinfo 83 | type, bind(c), public :: c_addrinfo 84 | integer(kind=c_int) :: ai_flags = 0 85 | integer(kind=c_int) :: ai_family = 0 86 | integer(kind=c_int) :: ai_socktype = 0 87 | integer(kind=c_int) :: ai_protocol = 0 88 | integer(kind=c_socklen_t) :: ai_addrlen = 0_c_socklen_t 89 | type(c_ptr) :: ai_canonname = c_null_ptr 90 | type(c_ptr) :: ai_addr = c_null_ptr 91 | type(c_ptr) :: ai_next = c_null_ptr 92 | end type c_addrinfo 93 | 94 | ! struct sockaddr_in 95 | type, bind(c), public :: c_sockaddr_in 96 | integer(kind=c_int8_t) :: sin_len = 0_c_int8_t 97 | integer(kind=c_int) :: sin_family = 0 98 | integer(kind=c_int16_t) :: sin_port = 0_c_int16_t 99 | type(c_in_addr) :: sin_addr 100 | character(kind=c_char) :: sin_zero(0:7) = c_null_char 101 | end type c_sockaddr_in 102 | 103 | #endif 104 | 105 | public :: c_gai_strerror 106 | public :: c_getaddrinfo 107 | public :: c_freeaddrinfo 108 | 109 | interface 110 | ! const char *gai_strerror(int ecode) 111 | function c_gai_strerror(ecode) bind(c, name='gai_strerror') 112 | import :: c_int, c_ptr 113 | implicit none 114 | integer(kind=c_int), intent(in), value :: ecode 115 | type(c_ptr) :: c_gai_strerror 116 | end function c_gai_strerror 117 | 118 | ! int getaddrinfo(const char *node, const char *service, const struct addrinfo *hints, struct addrinfo **res) 119 | function c_getaddrinfo(node, service, hints, res) bind(c, name='getaddrinfo') 120 | import :: c_int, c_ptr 121 | implicit none 122 | type(c_ptr), intent(in), value :: node 123 | type(c_ptr), intent(in), value :: service 124 | type(c_ptr), intent(in), value :: hints 125 | type(c_ptr), intent(in) :: res 126 | integer(kind=c_int) :: c_getaddrinfo 127 | end function c_getaddrinfo 128 | 129 | ! void freeaddrinfo(struct addrinfo *res) 130 | subroutine c_freeaddrinfo(res) bind(c, name='freeaddrinfo') 131 | import :: c_ptr 132 | implicit none 133 | type(c_ptr), intent(in), value :: res 134 | end subroutine c_freeaddrinfo 135 | end interface 136 | end module unix_netdb 137 | -------------------------------------------------------------------------------- /src/unix_pthread.F90: -------------------------------------------------------------------------------- 1 | ! unix_pthread.F90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | module unix_pthread 6 | use, intrinsic :: iso_c_binding 7 | implicit none 8 | private 9 | 10 | #if defined (__linux__) 11 | 12 | integer(kind=c_int), parameter :: PTHREAD_CREATE_DETACHED = 1 13 | 14 | integer(kind=c_int), parameter :: PTHREAD_CANCEL_ENABLE = 0 15 | integer(kind=c_int), parameter :: PTHREAD_CANCEL_DISABLE = 1 16 | integer(kind=c_int), parameter :: PTHREAD_CANCEL_DEFERRED = 0 17 | integer(kind=c_int), parameter :: PTHREAD_CANCEL_ASYNCHRONOUS = 1 18 | integer(kind=c_int), parameter :: PTHREAD_CANCELED = -1 19 | 20 | integer(kind=c_int), parameter :: PTHREAD_EXPLICIT_SCHED = 1 21 | integer(kind=c_int), parameter :: PTHREAD_PROCESS_PRIVATE = 0 22 | 23 | integer(kind=c_int), parameter :: PTHREAD_MUTEX_NORMAL = 0 24 | integer(kind=c_int), parameter :: PTHREAD_MUTEX_ERRORCHECK = 2 25 | integer(kind=c_int), parameter :: PTHREAD_MUTEX_RECURSIVE = 1 26 | 27 | integer, parameter :: PTHREAD_SIZE = 8 ! 8 Bytes. 28 | integer, parameter :: PTHREAD_MUTEX_SIZE = 40 ! 40 Bytes. 29 | 30 | #elif defined (__FreeBSD__) 31 | 32 | integer(kind=c_int), parameter :: PTHREAD_DETACHED = int(z'1') 33 | integer(kind=c_int), parameter :: PTHREAD_SCOPE_SYSTEM = int(z'2') 34 | integer(kind=c_int), parameter :: PTHREAD_INHERIT_SCHED = int(z'4') 35 | integer(kind=c_int), parameter :: PTHREAD_NOFLOAT = int(z'8') 36 | 37 | integer(kind=c_int), parameter :: PTHREAD_CREATE_DETACHED = PTHREAD_DETACHED 38 | integer(kind=c_int), parameter :: PTHREAD_CREATE_JOINABLE = 0 39 | integer(kind=c_int), parameter :: PTHREAD_SCOPE_PROCESS = 0 40 | integer(kind=c_int), parameter :: PTHREAD_EXPLICIT_SCHED = 0 41 | 42 | integer(kind=c_int), parameter :: PTHREAD_PROCESS_PRIVATE = 0 43 | integer(kind=c_int), parameter :: PTHREAD_PROCESS_SHARED = 1 44 | 45 | integer(kind=c_int), parameter :: PTHREAD_CANCEL_ENABLE = 0 46 | integer(kind=c_int), parameter :: PTHREAD_CANCEL_DISABLE = 1 47 | integer(kind=c_int), parameter :: PTHREAD_CANCEL_DEFERRED = 0 48 | integer(kind=c_int), parameter :: PTHREAD_CANCEL_ASYNCHRONOUS = 2 49 | integer(kind=c_int), parameter :: PTHREAD_CANCELED = 1 50 | 51 | integer(kind=c_int), parameter :: PTHREAD_MUTEX_ERRORCHECK = 1 ! Default POSIX mutex. 52 | integer(kind=c_int), parameter :: PTHREAD_MUTEX_RECURSIVE = 2 ! Recursive mutex. 53 | integer(kind=c_int), parameter :: PTHREAD_MUTEX_NORMAL = 3 ! No error checking. 54 | integer(kind=c_int), parameter :: PTHREAD_MUTEX_ADAPTIVE_NP = 4 ! Adaptive mutex, spins briefly before blocking on lock. 55 | integer(kind=c_int), parameter :: PTHREAD_MUTEX_DEFAULT = PTHREAD_MUTEX_ERRORCHECK 56 | 57 | integer, parameter :: PTHREAD_SIZE = 8 ! 8 Bytes. 58 | integer, parameter :: PTHREAD_MUTEX_SIZE = 8 ! 8 Bytes. 59 | 60 | #endif 61 | 62 | ! struct pthread_t 63 | type, bind(c), public :: c_pthread_t 64 | private 65 | character(kind=c_char) :: hidden(PTHREAD_SIZE) 66 | end type c_pthread_t 67 | 68 | ! struct pthread_mutex_t 69 | type, bind(c), public :: c_pthread_mutex_t 70 | private 71 | character(kind=c_char) :: hidden(PTHREAD_MUTEX_SIZE) 72 | end type c_pthread_mutex_t 73 | 74 | public :: c_pthread_cancel 75 | public :: c_pthread_create 76 | public :: c_pthread_detach 77 | public :: c_pthread_exit 78 | public :: c_pthread_join 79 | public :: c_pthread_mutex_destroy 80 | public :: c_pthread_mutex_init 81 | public :: c_pthread_mutex_lock 82 | public :: c_pthread_mutex_trylock 83 | public :: c_pthread_mutex_unlock 84 | public :: c_pthread_setcancelstate 85 | public :: c_pthread_setcanceltype 86 | 87 | interface 88 | ! int pthread_cancel(pthread_t thread) 89 | function c_pthread_cancel(thread) bind(c, name='pthread_cancel') 90 | import :: c_int, c_ptr, c_pthread_t 91 | implicit none 92 | type(c_pthread_t), intent(in), value :: thread 93 | integer(kind=c_int) :: c_pthread_cancel 94 | end function c_pthread_cancel 95 | 96 | ! int pthread_create(pthread_t *thread, const pthread_attr_t *attr, void *(*start_routine) (void *), void *arg) 97 | function c_pthread_create(thread, attr, start_routine, arg) bind(c, name='pthread_create') 98 | import :: c_int, c_ptr, c_funptr, c_pthread_t 99 | implicit none 100 | type(c_pthread_t), intent(inout) :: thread 101 | type(c_ptr), intent(in), value :: attr 102 | type(c_funptr), intent(in), value :: start_routine 103 | type(c_ptr), intent(in), value :: arg 104 | integer(kind=c_int) :: c_pthread_create 105 | end function c_pthread_create 106 | 107 | ! int pthread_detach(pthread_t thread) 108 | function c_pthread_detach(thread) bind(c, name='pthread_detach') 109 | import :: c_int, c_ptr, c_pthread_t 110 | implicit none 111 | type(c_pthread_t), intent(in), value :: thread 112 | integer(kind=c_int) :: c_pthread_detach 113 | end function c_pthread_detach 114 | 115 | ! void pthread_exit(void *retval) 116 | subroutine c_pthread_exit(retval) bind(c, name='pthread_exit') 117 | import :: c_ptr 118 | implicit none 119 | type(c_ptr), intent(in), value :: retval 120 | end subroutine c_pthread_exit 121 | 122 | ! int pthread_join(pthread_t thread, void **value_ptr) 123 | function c_pthread_join(thread, value_ptr) bind(c, name='pthread_join') 124 | import :: c_int, c_ptr, c_pthread_t 125 | implicit none 126 | type(c_pthread_t), intent(in), value :: thread 127 | type(c_ptr), intent(out) :: value_ptr 128 | integer(kind=c_int) :: c_pthread_join 129 | end function c_pthread_join 130 | 131 | ! int pthread_mutex_destroy(pthread_mutex_t *mutex) 132 | function c_pthread_mutex_destroy(mutex) bind(c, name='pthread_mutex_destroy') 133 | import :: c_int, c_pthread_mutex_t 134 | implicit none 135 | type(c_pthread_mutex_t), intent(in) :: mutex 136 | integer(kind=c_int) :: c_pthread_mutex_destroy 137 | end function c_pthread_mutex_destroy 138 | 139 | ! int pthread_mutex_init(pthread_mutex_t *mutex, const pthread_mutexattr_t *attr) 140 | function c_pthread_mutex_init(mutex, attr) bind(c, name='pthread_mutex_init') 141 | import :: c_int, c_ptr, c_pthread_mutex_t 142 | implicit none 143 | type(c_pthread_mutex_t), intent(in) :: mutex 144 | type(c_ptr), intent(in), value :: attr 145 | integer(kind=c_int) :: c_pthread_mutex_init 146 | end function c_pthread_mutex_init 147 | 148 | ! int pthread_mutex_lock(pthread_mutex_t *mutex) 149 | function c_pthread_mutex_lock(mutex) bind(c, name='pthread_mutex_lock') 150 | import :: c_int, c_pthread_mutex_t 151 | implicit none 152 | type(c_pthread_mutex_t), intent(in) :: mutex 153 | integer(kind=c_int) :: c_pthread_mutex_lock 154 | end function c_pthread_mutex_lock 155 | 156 | ! int pthread_mutex_trylock(pthread_mutex_t *mutex) 157 | function c_pthread_mutex_trylock(mutex) bind(c, name='pthread_mutex_trylock') 158 | import :: c_int, c_pthread_mutex_t 159 | implicit none 160 | type(c_pthread_mutex_t), intent(in) :: mutex 161 | integer(kind=c_int) :: c_pthread_mutex_trylock 162 | end function c_pthread_mutex_trylock 163 | 164 | ! int pthread_mutex_unlock(pthread_mutex_t *mutex) 165 | function c_pthread_mutex_unlock(mutex) bind(c, name='pthread_mutex_unlock') 166 | import :: c_int, c_pthread_mutex_t 167 | implicit none 168 | type(c_pthread_mutex_t), intent(in) :: mutex 169 | integer(kind=c_int) :: c_pthread_mutex_unlock 170 | end function c_pthread_mutex_unlock 171 | 172 | ! int pthread_setcancelstate(int state, int *oldstate) 173 | function c_pthread_setcancelstate(state, oldstate) bind(c, name='pthread_setcancelstate') 174 | import :: c_int 175 | implicit none 176 | integer(kind=c_int), intent(in), value :: state 177 | integer(kind=c_int), intent(out) :: oldstate 178 | integer(kind=c_int) :: c_pthread_setcancelstate 179 | end function c_pthread_setcancelstate 180 | 181 | ! int pthread_setcanceltype(int type, int *oldtype) 182 | function c_pthread_setcanceltype(type, oldtype) bind(c, name='pthread_setcanceltype') 183 | import :: c_int 184 | implicit none 185 | integer(kind=c_int), intent(in), value :: type 186 | integer(kind=c_int), intent(out) :: oldtype 187 | integer(kind=c_int) :: c_pthread_setcanceltype 188 | end function c_pthread_setcanceltype 189 | end interface 190 | end module unix_pthread 191 | -------------------------------------------------------------------------------- /src/unix_regex.F90: -------------------------------------------------------------------------------- 1 | ! unix_regex.F90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | module unix_regex 6 | use, intrinsic :: iso_c_binding 7 | use :: unix_types 8 | implicit none 9 | private 10 | 11 | #if defined (__linux__) 12 | 13 | integer(kind=c_int), parameter, public :: REG_EXTENDED = 1 14 | integer(kind=c_int), parameter, public :: REG_ICASE = shiftl(1, 1) 15 | integer(kind=c_int), parameter, public :: REG_NEWLINE = shiftl(1, 2) 16 | integer(kind=c_int), parameter, public :: REG_NOSUB = shiftl(1, 3) 17 | integer(kind=c_int), parameter, public :: REG_NOTBOL = 1 18 | integer(kind=c_int), parameter, public :: REG_NOTEOL = shiftl(1, 1) 19 | integer(kind=c_int), parameter, public :: REG_STARTEND = shiftl(1, 2) 20 | 21 | integer(kind=c_int), parameter, public :: REG_ENOSYS = -1 22 | integer(kind=c_int), parameter, public :: REG_NOERROR = 0 23 | integer(kind=c_int), parameter, public :: REG_NOMATCH = 1 24 | integer(kind=c_int), parameter, public :: REG_BADPAT = 2 25 | integer(kind=c_int), parameter, public :: REG_ECOLLATE = 3 26 | integer(kind=c_int), parameter, public :: REG_ECTYPE = 4 27 | integer(kind=c_int), parameter, public :: REG_EESCAPE = 5 28 | integer(kind=c_int), parameter, public :: REG_ESUBREG = 6 29 | integer(kind=c_int), parameter, public :: REG_EBRACK = 7 30 | integer(kind=c_int), parameter, public :: REG_EPAREN = 8 31 | integer(kind=c_int), parameter, public :: REG_EBRACE = 9 32 | integer(kind=c_int), parameter, public :: REG_BADBR = 10 33 | integer(kind=c_int), parameter, public :: REG_ERANGE = 11 34 | integer(kind=c_int), parameter, public :: REG_ESPACE = 12 35 | integer(kind=c_int), parameter, public :: REG_BADRPT = 13 36 | integer(kind=c_int), parameter, public :: REG_EEND = 14 37 | integer(kind=c_int), parameter, public :: REG_ESIZE = 15 38 | integer(kind=c_int), parameter, public :: REG_ERPAREN = 16 39 | 40 | ! struct regex_t 41 | type, bind(c), public :: c_regex_t 42 | private 43 | character(kind=c_char) :: hidden(64) 44 | end type c_regex_t 45 | 46 | #elif defined (__FreeBSD__) 47 | 48 | ! regcomp() flags 49 | integer(kind=c_int), parameter, public :: REG_BASIC = int(o'0000') 50 | integer(kind=c_int), parameter, public :: REG_EXTENDED = int(o'0001') 51 | integer(kind=c_int), parameter, public :: REG_ICASE = int(o'0002') 52 | integer(kind=c_int), parameter, public :: REG_NOSUB = int(o'0004') 53 | integer(kind=c_int), parameter, public :: REG_NEWLINE = int(o'0010') 54 | integer(kind=c_int), parameter, public :: REG_NOSPEC = int(o'0020') 55 | integer(kind=c_int), parameter, public :: REG_PEND = int(o'0040') 56 | integer(kind=c_int), parameter, public :: REG_DUMP = int(o'0200') 57 | 58 | ! regerror() flags 59 | integer(kind=c_int), parameter, public :: REG_ENOSYS = -1 60 | integer(kind=c_int), parameter, public :: REG_NOMATCH = 1 61 | integer(kind=c_int), parameter, public :: REG_BADPAT = 2 62 | integer(kind=c_int), parameter, public :: REG_ECOLLATE = 3 63 | integer(kind=c_int), parameter, public :: REG_ECTYPE = 4 64 | integer(kind=c_int), parameter, public :: REG_EESCAPE = 5 65 | integer(kind=c_int), parameter, public :: REG_ESUBREG = 6 66 | integer(kind=c_int), parameter, public :: REG_EBRACK = 7 67 | integer(kind=c_int), parameter, public :: REG_EPAREN = 8 68 | integer(kind=c_int), parameter, public :: REG_EBRACE = 9 69 | integer(kind=c_int), parameter, public :: REG_BADBR = 10 70 | integer(kind=c_int), parameter, public :: REG_ERANGE = 11 71 | integer(kind=c_int), parameter, public :: REG_ESPACE = 12 72 | integer(kind=c_int), parameter, public :: REG_BADRPT = 13 73 | integer(kind=c_int), parameter, public :: REG_EMPTY = 14 74 | integer(kind=c_int), parameter, public :: REG_ASSERT = 15 75 | integer(kind=c_int), parameter, public :: REG_INVARG = 16 76 | integer(kind=c_int), parameter, public :: REG_ILLSEQ = 17 77 | integer(kind=c_int), parameter, public :: REG_ATOI = 255 78 | integer(kind=c_int), parameter, public :: REG_ITOA = int(o'0400') 79 | 80 | ! regexec() flags 81 | integer(kind=c_int), parameter, public :: REG_NOTBOL = int(o'00001') 82 | integer(kind=c_int), parameter, public :: REG_NOTEOL = int(o'00002') 83 | integer(kind=c_int), parameter, public :: REG_STARTEND = int(o'00004') 84 | integer(kind=c_int), parameter, public :: REG_TRACE = int(o'00400') 85 | integer(kind=c_int), parameter, public :: REG_LARGE = int(o'01000') 86 | integer(kind=c_int), parameter, public :: REG_BACKR = int(o'02000') 87 | 88 | ! struct regex_t 89 | type, bind(c), public :: c_regex_t 90 | integer(kind=c_int) :: re_magic = 0 91 | integer(kind=c_size_t) :: re_nsub = 0_c_size_t 92 | type(c_ptr) :: re_endp = c_null_ptr 93 | type(c_ptr) :: re_g = c_null_ptr 94 | end type c_regex_t 95 | 96 | #endif 97 | 98 | type, bind(c), public :: c_regmatch_t 99 | integer(kind=c_regoff_t) :: rm_so = 0_c_regoff_t ! Start of match. 100 | integer(kind=c_regoff_t) :: rm_eo = 0_c_regoff_t ! End of match. 101 | end type c_regmatch_t 102 | 103 | public :: c_regcomp 104 | public :: c_regerror 105 | public :: c_regexec 106 | public :: c_regfree 107 | 108 | interface 109 | ! int regcomp(regex_t *preg, const char *regex, int cflags); 110 | function c_regcomp(preg, regex, cflags) bind(c, name='regcomp') 111 | import :: c_char, c_int, c_regex_t 112 | implicit none 113 | type(c_regex_t), intent(in) :: preg 114 | character(kind=c_char), intent(in) :: regex 115 | integer(kind=c_int), intent(in), value :: cflags 116 | integer(kind=c_int) :: c_regcomp 117 | end function c_regcomp 118 | 119 | ! size_t regerror(int errcode, const regex_t *preg, char *errbuf, size_t errbuf_size); 120 | function c_regerror(errcode, preg, errbuf, errbuf_size) bind(c, name='regerror') 121 | import :: c_int, c_ptr, c_regex_t, c_size_t 122 | implicit none 123 | integer(kind=c_int), intent(in), value :: errcode 124 | type(c_regex_t), intent(in) :: preg 125 | type(c_ptr), intent(in), value :: errbuf 126 | integer(kind=c_size_t), intent(in), value :: errbuf_size 127 | integer(kind=c_size_t) :: c_regerror 128 | end function c_regerror 129 | 130 | ! int regexec(const regex_t *preg, const char *string, size_t nmatch, regmatch_t pmatch[], int eflags); 131 | function c_regexec(preg, string, nmatch, pmatch, eflags) bind(c, name='regexec') 132 | import :: c_char, c_int, c_ptr, c_regex_t, c_size_t 133 | implicit none 134 | type(c_regex_t), intent(in) :: preg 135 | character(kind=c_char), intent(in) :: string 136 | integer(kind=c_size_t), intent(in), value :: nmatch 137 | type(c_ptr), intent(in), value :: pmatch 138 | integer(kind=c_int), intent(in), value :: eflags 139 | integer(kind=c_int) :: c_regexec 140 | end function c_regexec 141 | 142 | ! void regfree(regex_t *preg) 143 | subroutine c_regfree(preg) bind(c, name='regfree') 144 | import :: c_regex_t 145 | implicit none 146 | type(c_regex_t), intent(inout) :: preg 147 | end subroutine c_regfree 148 | end interface 149 | end module unix_regex 150 | -------------------------------------------------------------------------------- /src/unix_semaphore.F90: -------------------------------------------------------------------------------- 1 | ! unix_semaphore.F90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | module unix_semaphore 6 | use, intrinsic :: iso_c_binding 7 | use :: unix_time 8 | use :: unix_types 9 | implicit none 10 | private 11 | 12 | #if defined (__linux__) 13 | 14 | integer, parameter :: SEM_SIZE = 32 15 | 16 | #elif defined (__FreeBSD__) 17 | 18 | integer, parameter :: SEM_SIZE = 16 19 | 20 | #endif 21 | 22 | ! struct sem_t 23 | type, bind(c), public :: c_sem_t 24 | private 25 | character(kind=c_char) :: hidden(SEM_SIZE) 26 | end type c_sem_t 27 | 28 | public :: c_sem_close ! named 29 | public :: c_sem_destroy ! unnamed 30 | public :: c_sem_getvalue ! named, unnamed 31 | public :: c_sem_init ! unnamed 32 | public :: c_sem_open ! named 33 | public :: c_sem_post ! named, unnamed 34 | public :: c_sem_timedwait ! named, unnamed 35 | public :: c_sem_trywait ! named, unnamed 36 | public :: c_sem_unlink ! named 37 | public :: c_sem_wait ! named, unnamed 38 | 39 | interface 40 | ! int sem_close(sem_t *sem) 41 | function c_sem_close(sem) bind(c, name='sem_close') 42 | import :: c_int, c_ptr 43 | implicit none 44 | type(c_ptr), intent(in), value :: sem 45 | integer(kind=c_int) :: c_sem_close 46 | end function c_sem_close 47 | 48 | ! int sem_destroy(sem_t *sem) 49 | function c_sem_destroy(sem) bind(c, name='sem_destroy') 50 | import :: c_int, c_sem_t 51 | implicit none 52 | type(c_sem_t), intent(in) :: sem 53 | integer(kind=c_int) :: c_sem_destroy 54 | end function c_sem_destroy 55 | 56 | ! int sem_getvalue(sem_t *sem, int *value) 57 | function c_sem_getvalue(sem, value) bind(c, name='sem_getvalue') 58 | import :: c_int, c_ptr 59 | implicit none 60 | type(c_ptr), intent(in), value :: sem 61 | integer(kind=c_int), intent(out) :: value 62 | integer(kind=c_int) :: c_sem_getvalue 63 | end function c_sem_getvalue 64 | 65 | ! int sem_init(sem_t *sem, int, unsigned int value) 66 | function c_sem_init(sem, value) bind(c, name='sem_init') 67 | import :: c_int, c_sem_t, c_unsigned 68 | implicit none 69 | type(c_sem_t), intent(in) :: sem 70 | integer(kind=c_unsigned), intent(in), value :: value 71 | integer(kind=c_int) :: c_sem_init 72 | end function c_sem_init 73 | 74 | ! sem_t *semsem_open(const char *name, int oflag, mode_t mode, unsigned int value) 75 | function c_sem_open(name, oflag, mode, value) bind(c, name='sem_open') 76 | import :: c_char, c_int, c_mode_t, c_ptr, c_unsigned 77 | implicit none 78 | character(kind=c_char), intent(in) :: name 79 | integer(kind=c_int), intent(in), value :: oflag 80 | integer(kind=c_mode_t), intent(in), value :: mode 81 | integer(kind=c_unsigned), intent(in), value :: value 82 | type(c_ptr) :: c_sem_open 83 | end function c_sem_open 84 | 85 | ! int sem_post(sem_t *sem) 86 | function c_sem_post(sem) bind(c, name='sem_post') 87 | import :: c_int, c_ptr 88 | implicit none 89 | type(c_ptr), intent(in), value :: sem 90 | integer(kind=c_int) :: c_sem_post 91 | end function c_sem_post 92 | 93 | ! int sem_timedwait(sem_t *sem, const struct timespec *abs_timeout) 94 | function c_sem_timedwait(sem, abs_timeout) bind(c, name='sem_timedwait') 95 | import :: c_int, c_ptr, c_timespec 96 | implicit none 97 | type(c_ptr), intent(in), value :: sem 98 | type(c_timespec), intent(in) :: abs_timeout 99 | integer(kind=c_int) :: c_sem_timedwait 100 | end function c_sem_timedwait 101 | 102 | ! int sem_trywait(sem_t *sem) 103 | function c_sem_trywait(sem) bind(c, name='sem_trywait') 104 | import :: c_int, c_ptr 105 | implicit none 106 | type(c_ptr), intent(in), value :: sem 107 | integer(kind=c_int) :: c_sem_trywait 108 | end function c_sem_trywait 109 | 110 | ! int sem_unlink(const char *name) 111 | function c_sem_unlink(name) bind(c, name='sem_unlink') 112 | import :: c_char, c_int 113 | implicit none 114 | character(kind=c_char), intent(in) :: name 115 | integer(kind=c_int) :: c_sem_unlink 116 | end function c_sem_unlink 117 | 118 | ! int sem_wait(sem_t *sem) 119 | function c_sem_wait(sem) bind(c, name='sem_wait') 120 | import :: c_int, c_ptr 121 | implicit none 122 | type(c_ptr), intent(in), value :: sem 123 | integer(kind=c_int) :: c_sem_wait 124 | end function c_sem_wait 125 | end interface 126 | end module unix_semaphore 127 | -------------------------------------------------------------------------------- /src/unix_signal.F90: -------------------------------------------------------------------------------- 1 | ! unix_signal.F90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | module unix_signal 6 | use, intrinsic :: iso_c_binding 7 | use :: unix_types 8 | implicit none 9 | private 10 | 11 | #if defined (__linux__) 12 | 13 | integer(kind=c_int), parameter, public :: SIGHUP = 1 14 | integer(kind=c_int), parameter, public :: SIGINT = 2 15 | integer(kind=c_int), parameter, public :: SIGQUIT = 3 16 | integer(kind=c_int), parameter, public :: SIGILL = 4 17 | integer(kind=c_int), parameter, public :: SIGTRAP = 5 18 | integer(kind=c_int), parameter, public :: SIGABRT = 6 19 | integer(kind=c_int), parameter, public :: SIGIOT = 6 20 | integer(kind=c_int), parameter, public :: SIGBUS = 7 21 | integer(kind=c_int), parameter, public :: SIGFPE = 8 22 | integer(kind=c_int), parameter, public :: SIGKILL = 9 23 | integer(kind=c_int), parameter, public :: SIGUSR1 = 10 24 | integer(kind=c_int), parameter, public :: SIGSEGV = 11 25 | integer(kind=c_int), parameter, public :: SIGUSR2 = 12 26 | integer(kind=c_int), parameter, public :: SIGPIPE = 13 27 | integer(kind=c_int), parameter, public :: SIGALRM = 14 28 | integer(kind=c_int), parameter, public :: SIGTERM = 15 29 | integer(kind=c_int), parameter, public :: SIGSTKFLT = 16 30 | integer(kind=c_int), parameter, public :: SIGCHLD = 17 31 | integer(kind=c_int), parameter, public :: SIGCONT = 18 32 | integer(kind=c_int), parameter, public :: SIGSTOP = 19 33 | integer(kind=c_int), parameter, public :: SIGTSTP = 20 34 | integer(kind=c_int), parameter, public :: SIGTTIN = 21 35 | integer(kind=c_int), parameter, public :: SIGTTOU = 22 36 | integer(kind=c_int), parameter, public :: SIGURG = 23 37 | integer(kind=c_int), parameter, public :: SIGXCPU = 24 38 | integer(kind=c_int), parameter, public :: SIGXFSZ = 25 39 | integer(kind=c_int), parameter, public :: SIGVTALRM = 26 40 | integer(kind=c_int), parameter, public :: SIGPROF = 27 41 | integer(kind=c_int), parameter, public :: SIGWINCH = 28 42 | integer(kind=c_int), parameter, public :: SIGIO = 29 43 | integer(kind=c_int), parameter, public :: SIGPOLL = SIGIO 44 | integer(kind=c_int), parameter, public :: SIGPWR = 30 45 | integer(kind=c_int), parameter, public :: SIGSYS = 31 46 | integer(kind=c_int), parameter, public :: SIGUNUSED = 31 47 | 48 | #elif defined (__FreeBSD__) 49 | 50 | integer(kind=c_int), parameter, public :: SIGHUP = 1 51 | integer(kind=c_int), parameter, public :: SIGINT = 2 52 | integer(kind=c_int), parameter, public :: SIGQUIT = 3 53 | integer(kind=c_int), parameter, public :: SIGILL = 4 54 | integer(kind=c_int), parameter, public :: SIGTRAP = 5 55 | integer(kind=c_int), parameter, public :: SIGABRT = 6 56 | integer(kind=c_int), parameter, public :: SIGIOT = SIGABRT 57 | integer(kind=c_int), parameter, public :: SIGEMT = 7 58 | integer(kind=c_int), parameter, public :: SIGFPE = 8 59 | integer(kind=c_int), parameter, public :: SIGKILL = 9 60 | integer(kind=c_int), parameter, public :: SIGBUS = 10 61 | integer(kind=c_int), parameter, public :: SIGSEGV = 11 62 | integer(kind=c_int), parameter, public :: SIGSYS = 12 63 | integer(kind=c_int), parameter, public :: SIGPIPE = 13 64 | integer(kind=c_int), parameter, public :: SIGALRM = 14 65 | integer(kind=c_int), parameter, public :: SIGTERM = 15 66 | integer(kind=c_int), parameter, public :: SIGURG = 16 67 | integer(kind=c_int), parameter, public :: SIGSTOP = 17 68 | integer(kind=c_int), parameter, public :: SIGTSTP = 18 69 | integer(kind=c_int), parameter, public :: SIGCONT = 19 70 | integer(kind=c_int), parameter, public :: SIGCHLD = 20 71 | integer(kind=c_int), parameter, public :: SIGTTIN = 21 72 | integer(kind=c_int), parameter, public :: SIGTTOU = 22 73 | integer(kind=c_int), parameter, public :: SIGIO = 23 74 | integer(kind=c_int), parameter, public :: SIGXCPU = 24 75 | integer(kind=c_int), parameter, public :: SIGXFSZ = 25 76 | integer(kind=c_int), parameter, public :: SIGVTALRM = 26 77 | integer(kind=c_int), parameter, public :: SIGPROF = 27 78 | integer(kind=c_int), parameter, public :: SIGWINCH = 28 79 | integer(kind=c_int), parameter, public :: SIGINFO = 29 80 | integer(kind=c_int), parameter, public :: SIGUSR1 = 30 81 | integer(kind=c_int), parameter, public :: SIGUSR2 = 31 82 | 83 | #endif 84 | 85 | public :: c_kill 86 | public :: c_signal 87 | 88 | interface 89 | ! int kill(pid_t pid, int sig) 90 | function c_kill(pid, sig) bind(c, name='kill') 91 | import :: c_int, c_pid_t 92 | implicit none 93 | integer(kind=c_pid_t), intent(in), value :: pid 94 | integer(kind=c_int), intent(in), value :: sig 95 | integer(kind=c_int) :: c_kill 96 | end function c_kill 97 | 98 | ! sig_t signal(int sig, sig_t func) 99 | function c_signal(sig, func) bind(c, name='signal') 100 | import :: c_funptr, c_int 101 | implicit none 102 | integer(kind=c_int), intent(in), value :: sig 103 | type(c_funptr), intent(in), value :: func 104 | type(c_funptr) :: c_signal 105 | end function c_signal 106 | end interface 107 | end module unix_signal 108 | -------------------------------------------------------------------------------- /src/unix_socket.F90: -------------------------------------------------------------------------------- 1 | ! unix_socket.F90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | module unix_socket 6 | use, intrinsic :: iso_c_binding 7 | use :: unix_types 8 | implicit none 9 | private 10 | 11 | #if defined (__linux__) 12 | 13 | integer(kind=c_int), parameter, public :: SOL_SOCKET = 1 14 | 15 | integer(kind=c_int), parameter, public :: SO_DEBUG = 1 16 | integer(kind=c_int), parameter, public :: SO_REUSEADDR = 2 17 | integer(kind=c_int), parameter, public :: SO_TYPE = 3 18 | integer(kind=c_int), parameter, public :: SO_ERROR = 4 19 | integer(kind=c_int), parameter, public :: SO_DONTROUTE = 5 20 | integer(kind=c_int), parameter, public :: SO_BROADCAST = 6 21 | integer(kind=c_int), parameter, public :: SO_SNDBUF = 7 22 | integer(kind=c_int), parameter, public :: SO_RCVBUF = 8 23 | integer(kind=c_int), parameter, public :: SO_SNDBUFFORCE = 32 24 | integer(kind=c_int), parameter, public :: SO_RCVBUFFORCE = 33 25 | integer(kind=c_int), parameter, public :: SO_KEEPALIVE = 9 26 | integer(kind=c_int), parameter, public :: SO_OOBINLINE = 10 27 | integer(kind=c_int), parameter, public :: SO_NO_CHECK = 11 28 | integer(kind=c_int), parameter, public :: SO_PRIORITY = 12 29 | integer(kind=c_int), parameter, public :: SO_LINGER = 13 30 | integer(kind=c_int), parameter, public :: SO_BSDCOMPAT = 14 31 | integer(kind=c_int), parameter, public :: SO_REUSEPORT = 15 32 | 33 | #elif defined (__FreeBSD__) 34 | 35 | integer(kind=c_int), parameter, public :: SOL_SOCKET = int(z'ffff') 36 | 37 | integer(kind=c_int), parameter, public :: SO_DEBUG = int(z'00000001') 38 | integer(kind=c_int), parameter, public :: SO_ACCEPTCONN = int(z'00000002') 39 | integer(kind=c_int), parameter, public :: SO_REUSEADDR = int(z'00000004') 40 | integer(kind=c_int), parameter, public :: SO_KEEPALIVE = int(z'00000008') 41 | integer(kind=c_int), parameter, public :: SO_DONTROUTE = int(z'00000010') 42 | integer(kind=c_int), parameter, public :: SO_BROADCAST = int(z'00000020') 43 | 44 | #endif 45 | 46 | public :: c_accept 47 | public :: c_bind 48 | public :: c_connect 49 | public :: c_listen 50 | public :: c_send 51 | public :: c_setsockopt 52 | public :: c_socket 53 | 54 | interface 55 | ! int accept(int sockfd, struct sockaddr *addr, socklen_t *addrlen) 56 | function c_accept(sockfd, addr, addrlen) bind(c, name='accept') 57 | import :: c_int, c_ptr, c_size_t, c_socklen_t 58 | implicit none 59 | integer(kind=c_int), intent(in), value :: sockfd 60 | type(c_ptr), intent(in), value :: addr 61 | integer(kind=c_socklen_t), intent(in), value :: addrlen 62 | integer(kind=c_int) :: c_accept 63 | end function c_accept 64 | 65 | ! int bind(int sockfd, const struct sockaddr *addr, socklen_t addrlen) 66 | function c_bind(sockfd, addr, addrlen) bind(c, name='bind') 67 | import :: c_int, c_ptr, c_size_t, c_socklen_t 68 | implicit none 69 | integer(kind=c_int), intent(in), value :: sockfd 70 | type(c_ptr), intent(in), value :: addr 71 | integer(kind=c_socklen_t), intent(in), value :: addrlen 72 | integer(kind=c_int) :: c_bind 73 | end function c_bind 74 | 75 | ! int connect(int sockfd, const struct sockaddr *addr, socklen_t addrlen) 76 | function c_connect(sockfd, addr, addrlen) bind(c, name='connect') 77 | import :: c_int, c_ptr, c_size_t, c_socklen_t 78 | implicit none 79 | integer(kind=c_int), intent(in), value :: sockfd 80 | type(c_ptr), intent(in), value :: addr 81 | integer(kind=c_socklen_t), intent(in), value :: addrlen 82 | integer(kind=c_int) :: c_connect 83 | end function c_connect 84 | 85 | ! int listen(int sockfd, int backlog) 86 | function c_listen(sockfd, backlog) bind(c, name='listen') 87 | import :: c_int 88 | implicit none 89 | integer(kind=c_int), intent(in), value :: sockfd 90 | integer(kind=c_int), intent(in), value :: backlog 91 | integer(kind=c_int) :: c_listen 92 | end function c_listen 93 | 94 | ! ssize_t send(int sockfd, const void *buf, size_t len, int flags) 95 | function c_send(sockfd, buf, len, flags) bind(c, name='send') 96 | import :: c_int, c_ptr, c_size_t 97 | implicit none 98 | integer(kind=c_int), intent(in), value :: sockfd 99 | type(c_ptr), intent(in), value :: buf 100 | integer(kind=c_size_t), intent(in), value :: len 101 | integer(kind=c_int), intent(in), value :: flags 102 | integer(kind=c_size_t) :: c_send 103 | end function c_send 104 | 105 | ! int setsockopt(int sockfd, int level, int optname, const void *optval, socklen_t optlen) 106 | function c_setsockopt(sockfd, level, optname, optval, optlen) bind(c, name='setsockopt') 107 | import :: c_int, c_ptr, c_socklen_t 108 | implicit none 109 | integer(kind=c_int), intent(in), value :: sockfd 110 | integer(kind=c_int), intent(in), value :: level 111 | integer(kind=c_int), intent(in), value :: optname 112 | type(c_ptr), intent(in), value :: optval 113 | integer(kind=c_socklen_t), intent(in), value :: optlen 114 | integer(kind=c_int) :: c_setsockopt 115 | end function c_setsockopt 116 | 117 | ! int socket(int domain, int type, int protocol) 118 | function c_socket(domain, type, protocol) bind(c, name='socket') 119 | import :: c_int 120 | implicit none 121 | integer(kind=c_int), intent(in), value :: domain 122 | integer(kind=c_int), intent(in), value :: type 123 | integer(kind=c_int), intent(in), value :: protocol 124 | integer(kind=c_int) :: c_socket 125 | end function c_socket 126 | end interface 127 | end module unix_socket 128 | -------------------------------------------------------------------------------- /src/unix_stat.F90: -------------------------------------------------------------------------------- 1 | ! unix_stat.F90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | module unix_stat 6 | use, intrinsic :: iso_c_binding 7 | use :: unix_time 8 | use :: unix_types 9 | implicit none 10 | private 11 | 12 | #if defined (__linux__) 13 | 14 | integer(kind=c_int), parameter, public :: S_IRUSR = int(o'0400') 15 | integer(kind=c_int), parameter, public :: S_IWUSR = int(o'0200') 16 | integer(kind=c_int), parameter, public :: S_IXUSR = int(o'0100') 17 | integer(kind=c_int), parameter, public :: S_IRWXU = ior(ior(S_IRUSR, S_IWUSR), S_IXUSR) 18 | 19 | integer(kind=c_int), parameter, public :: S_IRWXG = shiftr(S_IRWXU, 3) 20 | integer(kind=c_int), parameter, public :: S_IRGRP = shiftr(S_IRUSR, 3) 21 | integer(kind=c_int), parameter, public :: S_IWGRP = shiftr(S_IWUSR, 3) 22 | integer(kind=c_int), parameter, public :: S_IXGRP = shiftr(S_IXUSR, 3) 23 | 24 | integer(kind=c_int), parameter, public :: S_IRWXO = shiftr(S_IRWXG, 3) 25 | integer(kind=c_int), parameter, public :: S_IROTH = shiftr(S_IRGRP, 3) 26 | integer(kind=c_int), parameter, public :: S_IWOTH = shiftr(S_IWGRP, 3) 27 | integer(kind=c_int), parameter, public :: S_IXOTH = shiftr(S_IXGRP, 3) 28 | 29 | integer(kind=c_int), parameter, public :: S_IFMT = int(o'0170000') 30 | integer(kind=c_int), parameter, public :: S_IFSOCK = int(o'0140000') 31 | integer(kind=c_int), parameter, public :: S_IFLNK = int(o'0120000') 32 | integer(kind=c_int), parameter, public :: S_IFREG = int(o'0100000') 33 | integer(kind=c_int), parameter, public :: S_IFBLK = int(o'0060000') 34 | integer(kind=c_int), parameter, public :: S_IFDIR = int(o'0040000') 35 | integer(kind=c_int), parameter, public :: S_IFCHR = int(o'0020000') 36 | integer(kind=c_int), parameter, public :: S_IFIFO = int(o'0010000') 37 | integer(kind=c_int), parameter, public :: S_ISUID = int(o'0004000') 38 | integer(kind=c_int), parameter, public :: S_ISGID = int(o'0002000') 39 | integer(kind=c_int), parameter, public :: S_ISVTX = int(o'0001000') 40 | 41 | #if defined(__aarch64__) 42 | 43 | ! struct stat (aarch64) 44 | type, bind(c), public :: c_stat_type 45 | integer(kind=c_dev_t) :: st_dev = 0 ! ID of device containing file 46 | integer(kind=c_ino_t) :: st_ino = 0 ! inode number 47 | integer(kind=c_mode_t) :: st_mode = 0 ! protection 48 | integer(kind=c_nlink_t) :: st_nlink = 0 ! number of hard links 49 | integer(kind=c_uid_t) :: st_uid = 0 ! user ID of owner 50 | integer(kind=c_gid_t) :: st_gid = 0 ! group ID of owner 51 | integer(kind=c_dev_t) :: st_rdev = 0 ! device ID (if special file) 52 | integer(kind=c_dev_t), private :: pad0 = 0 53 | integer(kind=c_off_t) :: st_size = 0 ! total size, in bytes 54 | integer(kind=c_blksize_t) :: st_blksize = 0 ! blocksize for file system I/O 55 | integer(kind=c_int), private :: pad1 = 0 56 | integer(kind=c_blkcnt_t) :: st_blocks = 0 ! number of 512B blocks allocated 57 | type(c_timespec) :: st_atim ! time of last access 58 | type(c_timespec) :: st_mtim ! time of last modification 59 | type(c_timespec) :: st_ctim ! time of last status change 60 | integer(kind=c_long), private :: reserved(2) = 0 61 | end type c_stat_type 62 | 63 | #else 64 | 65 | ! struct stat (x86-64) 66 | type, bind(c), public :: c_stat_type 67 | integer(kind=c_dev_t) :: st_dev = 0 ! ID of device containing file 68 | integer(kind=c_ino_t) :: st_ino = 0 ! inode number 69 | integer(kind=c_nlink_t) :: st_nlink = 0 ! number of hard links 70 | integer(kind=c_mode_t) :: st_mode = 0 ! protection 71 | integer(kind=c_uid_t) :: st_uid = 0 ! user ID of owner 72 | integer(kind=c_gid_t) :: st_gid = 0 ! group ID of owner 73 | integer(kind=c_int), private :: pad0 = 0 74 | integer(kind=c_dev_t) :: st_rdev = 0 ! device ID (if special file) 75 | integer(kind=c_off_t) :: st_size = 0 ! total size, in bytes 76 | integer(kind=c_blksize_t) :: st_blksize = 0 ! blocksize for file system I/O 77 | integer(kind=c_blkcnt_t) :: st_blocks = 0 ! number of 512B blocks allocated 78 | type(c_timespec) :: st_atim ! time of last access 79 | type(c_timespec) :: st_mtim ! time of last modification 80 | type(c_timespec) :: st_ctim ! time of last status change 81 | integer(kind=c_long), private :: reserved(3) = 0 82 | end type c_stat_type 83 | 84 | #endif 85 | 86 | #elif defined (__FreeBSD__) 87 | 88 | integer(kind=c_int), parameter, public :: S_IRWXU = int(o'0000700') 89 | integer(kind=c_int), parameter, public :: S_IRUSR = int(o'0000400') 90 | integer(kind=c_int), parameter, public :: S_IWUSR = int(o'0000200') 91 | integer(kind=c_int), parameter, public :: S_IXUSR = int(o'0000100') 92 | 93 | integer(kind=c_int), parameter, public :: S_IRWXG = int(o'0000070') 94 | integer(kind=c_int), parameter, public :: S_IRGRP = int(o'0000040') 95 | integer(kind=c_int), parameter, public :: S_IWGRP = int(o'0000020') 96 | integer(kind=c_int), parameter, public :: S_IXGRP = int(o'0000010') 97 | 98 | integer(kind=c_int), parameter, public :: S_IRWXO = int(o'0000007') 99 | integer(kind=c_int), parameter, public :: S_IROTH = int(o'0000004') 100 | integer(kind=c_int), parameter, public :: S_IWOTH = int(o'0000002') 101 | integer(kind=c_int), parameter, public :: S_IXOTH = int(o'0000001') 102 | 103 | integer(kind=c_int), parameter, public :: S_IFMT = int(o'0170000') ! type of file mask 104 | integer(kind=c_int), parameter, public :: S_IFIFO = int(o'0010000') ! named pipe (fifo) 105 | integer(kind=c_int), parameter, public :: S_IFCHR = int(o'0020000') ! character special 106 | integer(kind=c_int), parameter, public :: S_IFDIR = int(o'0040000') ! directory 107 | integer(kind=c_int), parameter, public :: S_IFBLK = int(o'0060000') ! block special 108 | integer(kind=c_int), parameter, public :: S_IFREG = int(o'0100000') ! regular 109 | integer(kind=c_int), parameter, public :: S_IFLNK = int(o'0120000') ! symbolic link 110 | integer(kind=c_int), parameter, public :: S_IFSOCK = int(o'0140000') ! socket 111 | integer(kind=c_int), parameter, public :: S_ISVTX = int(o'0001000') ! save swapped text even after use 112 | integer(kind=c_int), parameter, public :: S_IFWHT = int(o'0160000') ! whiteout 113 | 114 | ! struct stat 115 | type, bind(c), public :: c_stat_type 116 | integer(kind=c_dev_t) :: st_dev = 0 ! ID of device containing file 117 | integer(kind=c_ino_t) :: st_ino = 0 ! inode number 118 | integer(kind=c_nlink_t) :: st_nlink = 0 ! number of hard links 119 | integer(kind=c_mode_t) :: st_mode = 0 ! protection 120 | integer(kind=c_int16_t), private :: st_padding0 = 0 121 | integer(kind=c_uid_t) :: st_uid = 0 ! user ID of owner 122 | integer(kind=c_gid_t) :: st_gid = 0 ! group ID of owner 123 | integer(kind=c_int32_t), private :: st_padding1 = 0 124 | integer(kind=c_dev_t) :: st_rdev = 0 ! device ID (if special file) 125 | type(c_timespec) :: st_atim ! time of last access 126 | type(c_timespec) :: st_mtim ! time of last modification 127 | type(c_timespec) :: st_ctim ! time of last status change 128 | type(c_timespec) :: st_birthtim 129 | integer(kind=c_off_t) :: st_size = 0 ! total size, in bytes 130 | integer(kind=c_blkcnt_t) :: st_blocks = 0 ! number of 512B blocks allocated 131 | integer(kind=c_blksize_t) :: st_blksize = 0 ! blocksize for file system I/O 132 | integer(kind=c_fflags_t) :: st_flags = 0 133 | integer(kind=c_uint64_t) :: st_gen = 0 134 | integer(kind=c_uint64_t), private :: st_spare(10) = 0 135 | end type c_stat_type 136 | 137 | #endif 138 | 139 | public :: c_fstat 140 | public :: c_lstat 141 | public :: c_mkdir 142 | public :: c_mkfifo 143 | public :: c_umask 144 | public :: c_stat 145 | 146 | interface 147 | ! int fstat(int fd, struct stat *buf) 148 | function c_fstat(fd, buf) bind(c, name='fstat') 149 | import :: c_int, c_stat_type 150 | implicit none 151 | integer(kind=c_int), intent(in), value :: fd 152 | type(c_stat_type), intent(inout) :: buf 153 | integer(kind=c_int) :: c_fstat 154 | end function c_fstat 155 | 156 | ! int lstat(const char *path, struct stat *buf) 157 | function c_lstat(path, buf) bind(c, name='lstat') 158 | import :: c_char, c_int, c_stat_type 159 | implicit none 160 | character(kind=c_char), intent(in) :: path 161 | type(c_stat_type), intent(inout) :: buf 162 | integer(kind=c_int) :: c_lstat 163 | end function c_lstat 164 | 165 | ! int mkdir(const char *path, mode_t mode) 166 | function c_mkdir(path, mode) bind(c, name='mkdir') 167 | import :: c_char, c_int, c_mode_t 168 | implicit none 169 | character(kind=c_char), intent(in) :: path 170 | integer(kind=c_mode_t), intent(in), value :: mode 171 | integer(kind=c_int) :: c_mkdir 172 | end function c_mkdir 173 | 174 | ! int mkfifo(const char *path, mode_t mode) 175 | function c_mkfifo(path, mode) bind(c, name='mkfifo') 176 | import :: c_char, c_int, c_mode_t 177 | implicit none 178 | character(kind=c_char), intent(in) :: path 179 | integer(kind=c_mode_t), intent(in), value :: mode 180 | integer(kind=c_int) :: c_mkfifo 181 | end function c_mkfifo 182 | 183 | ! int stat(const char *path, struct stat *buf) 184 | function c_stat(path, buf) bind(c, name='stat') 185 | import :: c_char, c_int, c_stat_type 186 | implicit none 187 | character(kind=c_char), intent(in) :: path 188 | type(c_stat_type), intent(inout) :: buf 189 | integer(kind=c_int) :: c_stat 190 | end function c_stat 191 | 192 | ! mode_t umask(mode_t numask) 193 | function c_umask(numask) bind(c, name='umask') 194 | import :: c_mode_t 195 | implicit none 196 | integer(kind=c_mode_t), intent(in), value :: numask 197 | integer(kind=c_mode_t) :: c_umask 198 | end function c_umask 199 | end interface 200 | end module unix_stat 201 | -------------------------------------------------------------------------------- /src/unix_stdio.F90: -------------------------------------------------------------------------------- 1 | ! unix_stdio.F90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | module unix_stdio 6 | use, intrinsic :: iso_c_binding 7 | implicit none 8 | private 9 | 10 | integer(kind=c_int), parameter, public :: EOF = -1 11 | 12 | public :: c_getchar 13 | public :: c_fclose 14 | public :: c_fdopen 15 | public :: c_fflush 16 | public :: c_fgetc 17 | public :: c_fgets 18 | public :: c_fopen 19 | public :: c_fprintf 20 | public :: c_fputs 21 | public :: c_fread 22 | public :: c_fwrite 23 | public :: c_pclose 24 | public :: c_perror 25 | public :: c_popen 26 | public :: c_putchar 27 | public :: c_scanf 28 | public :: c_setbuf 29 | public :: c_setvbuf 30 | 31 | interface 32 | ! int getchar(void) 33 | function c_getchar() bind(c, name='getchar') 34 | import :: c_int 35 | implicit none 36 | integer(kind=c_int) :: c_getchar 37 | end function c_getchar 38 | 39 | ! int fclose(FILE *stream) 40 | function c_fclose(stream) bind(c, name='fclose') 41 | import :: c_int, c_ptr 42 | implicit none 43 | type(c_ptr), intent(in), value :: stream 44 | integer(kind=c_int) :: c_fclose 45 | end function c_fclose 46 | 47 | ! FILE *fopen(int fd, const char *mode) 48 | function c_fdopen(fd, mode) bind(c, name='fdopen') 49 | import :: c_char, c_int, c_ptr 50 | implicit none 51 | integer(kind=c_int), intent(in), value :: fd 52 | character(kind=c_char), intent(in) :: mode 53 | type(c_ptr) :: c_fdopen 54 | end function c_fdopen 55 | 56 | ! int fflush(FILE *stream) 57 | function c_fflush(stream) bind(c, name='fflush') 58 | import :: c_int, c_ptr 59 | implicit none 60 | type(c_ptr), intent(in), value :: stream 61 | integer(kind=c_int) :: c_fflush 62 | end function c_fflush 63 | 64 | ! int fgetc(FILE *stream) 65 | function c_fgetc(stream) bind(c, name='fgetc') 66 | import :: c_int, c_ptr 67 | implicit none 68 | type(c_ptr), intent(in), value :: stream 69 | integer(kind=c_int) :: c_fgetc 70 | end function c_fgetc 71 | 72 | ! char *fgets(char *str, int size, FILE *stream) 73 | function c_fgets(str, size, stream) bind(c, name='fgets') 74 | import :: c_char, c_int, c_ptr 75 | implicit none 76 | character(kind=c_char), intent(in) :: str 77 | integer(kind=c_int), intent(in), value :: size 78 | type(c_ptr), intent(in), value :: stream 79 | type(c_ptr) :: c_fgets 80 | end function c_fgets 81 | 82 | ! FILE *fopen(const char *path, const char *mode) 83 | function c_fopen(path, mode) bind(c, name='fopen') 84 | import :: c_char, c_ptr 85 | implicit none 86 | character(kind=c_char), intent(in) :: path 87 | character(kind=c_char), intent(in) :: mode 88 | type(c_ptr) :: c_fopen 89 | end function c_fopen 90 | 91 | ! int fprintf(FILE *stream, const char *format, ...) 92 | function c_fprintf(stream, format, str) bind(c, name='c_fprintf') 93 | import :: c_char, c_int, c_ptr 94 | implicit none 95 | type(c_ptr), intent(in), value :: stream 96 | character(kind=c_char), intent(in) :: format 97 | character(kind=c_char), intent(in) :: str 98 | integer(kind=c_int) :: c_fprintf 99 | end function c_fprintf 100 | 101 | ! int fputs(const char *str, FILE *stream) 102 | function c_fputs(str, stream) bind(c, name='fputs') 103 | import :: c_char, c_int, c_ptr 104 | implicit none 105 | character(kind=c_char), intent(in) :: str 106 | type(c_ptr), intent(in), value :: stream 107 | integer(kind=c_int) :: c_fputs 108 | end function c_fputs 109 | 110 | ! size_t fread(void *ptr, size_t size, size_t nmemb, FILE *stream) 111 | function c_fread(ptr, size, nmemb, stream) bind(c, name='fread') 112 | import :: c_ptr, c_size_t 113 | implicit none 114 | type(c_ptr), intent(in), value :: ptr 115 | integer(kind=c_size_t), intent(in), value :: size 116 | integer(kind=c_size_t), intent(in), value :: nmemb 117 | type(c_ptr), intent(in), value :: stream 118 | integer(kind=c_size_t) :: c_fread 119 | end function c_fread 120 | 121 | ! size_t fwrite(const void *ptr, size_t size, size_t nmemb, FILE *stream) 122 | function c_fwrite(ptr, size, nmemb, stream) bind(c, name='fwrite') 123 | import :: c_ptr, c_size_t 124 | implicit none 125 | type(c_ptr), intent(in), value :: ptr 126 | integer(kind=c_size_t), intent(in), value :: size 127 | integer(kind=c_size_t), intent(in), value :: nmemb 128 | type(c_ptr), intent(in), value :: stream 129 | integer(kind=c_size_t) :: c_fwrite 130 | end function c_fwrite 131 | 132 | ! int pclose(FILE *stream) 133 | function c_pclose(stream) bind(c, name='pclose') 134 | import :: c_int, c_ptr 135 | implicit none 136 | type(c_ptr), intent(in), value :: stream 137 | integer(kind=c_int) :: c_pclose 138 | end function c_pclose 139 | 140 | ! void perror(const char *str) 141 | subroutine c_perror(str) bind(c, name='perror') 142 | import :: c_char 143 | implicit none 144 | character(kind=c_char), intent(in) :: str 145 | end subroutine c_perror 146 | 147 | ! FILE *popen(const char *command, const char *type) 148 | function c_popen(command, type) bind(c, name='popen') 149 | import :: c_char, c_ptr 150 | implicit none 151 | character(kind=c_char), intent(in) :: command 152 | character(kind=c_char), intent(in) :: type 153 | type(c_ptr) :: c_popen 154 | end function c_popen 155 | 156 | ! int putchar(int char) 157 | function c_putchar(char) bind(c, name='putchar') 158 | import :: c_int 159 | implicit none 160 | integer(kind=c_int), intent(in), value :: char 161 | integer(kind=c_int) :: c_putchar 162 | end function c_putchar 163 | 164 | ! int scanf(const char *format, ...) 165 | function c_scanf(format, str) bind(c, name='c_scanf') 166 | import :: c_char, c_int 167 | implicit none 168 | character(kind=c_char), intent(in) :: format 169 | character(kind=c_char), intent(in) :: str 170 | integer(kind=c_int) :: c_scanf 171 | end function c_scanf 172 | 173 | ! void setbuf(FILE *stream, char *buf) 174 | subroutine c_setbuf(stream, buf) bind(c, name='setbuf') 175 | import :: c_int, c_ptr 176 | implicit none 177 | integer(kind=c_int), intent(in) :: stream 178 | type(c_ptr), intent(in), value :: buf 179 | end subroutine c_setbuf 180 | 181 | ! int setvbuf(FILE *stream, char *buf, int mode, size_t size) 182 | function c_setvbuf(stream, buf, mode, size) bind(c, name='setvbuf') 183 | import :: c_int, c_ptr, c_size_t 184 | implicit none 185 | integer(kind=c_int), intent(in) :: stream 186 | type(c_ptr), intent(in), value :: buf 187 | integer(kind=c_int), intent(in), value :: mode 188 | integer(kind=c_size_t), intent(in), value :: size 189 | integer(kind=c_int) :: c_setvbuf 190 | end function c_setvbuf 191 | end interface 192 | end module unix_stdio 193 | -------------------------------------------------------------------------------- /src/unix_stdlib.F90: -------------------------------------------------------------------------------- 1 | ! unix_stdlib.F90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | module unix_stdlib 6 | use, intrinsic :: iso_c_binding 7 | implicit none 8 | private 9 | 10 | integer(kind=c_int), parameter, public :: EXIT_SUCCESS = 0 11 | integer(kind=c_int), parameter, public :: EXIT_FAILURE = 1 12 | 13 | public :: c_exit 14 | public :: c_free 15 | 16 | interface 17 | ! void exit(int status) 18 | subroutine c_exit(status) bind(c, name='exit') 19 | import :: c_int 20 | implicit none 21 | integer(kind=c_int), intent(in), value :: status 22 | end subroutine c_exit 23 | 24 | ! void free(void *ptr) 25 | subroutine c_free(ptr) bind(c, name='free') 26 | import :: c_ptr 27 | implicit none 28 | type(c_ptr), intent(in), value :: ptr 29 | end subroutine c_free 30 | end interface 31 | end module unix_stdlib 32 | -------------------------------------------------------------------------------- /src/unix_string.F90: -------------------------------------------------------------------------------- 1 | ! unix_string.F90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | module unix_string 6 | use, intrinsic :: iso_c_binding 7 | implicit none 8 | private 9 | 10 | public :: c_memcpy 11 | public :: c_memset 12 | public :: c_strerror 13 | public :: c_strlen 14 | 15 | interface 16 | ! void *memset(void *dst, const void *src, size_t len) 17 | function c_memcpy(dst, src, len) bind(c, name='memcpy') 18 | import :: c_ptr, c_size_t 19 | implicit none 20 | type(c_ptr), intent(in), value :: dst 21 | type(c_ptr), intent(in), value :: src 22 | integer(kind=c_size_t), intent(in), value :: len 23 | type(c_ptr) :: c_memcpy 24 | end function c_memcpy 25 | 26 | ! void *memset(void *dest, int c, size_t len) 27 | function c_memset(dest, c, len) bind(c, name='memset') 28 | import :: c_int, c_ptr, c_size_t 29 | implicit none 30 | type(c_ptr), intent(in), value :: dest 31 | integer(kind=c_int), intent(in), value :: c 32 | integer(kind=c_size_t), intent(in), value :: len 33 | type(c_ptr) :: c_memset 34 | end function c_memset 35 | 36 | ! char *strerror(int errnum) 37 | function c_strerror(errnum) bind(c, name='strerror') 38 | import :: c_int, c_ptr 39 | implicit none 40 | integer(kind=c_int), intent(in), value :: errnum 41 | type(c_ptr) :: c_strerror 42 | end function c_strerror 43 | 44 | ! size_t strlen(const char *str) 45 | function c_strlen(str) bind(c, name='strlen') 46 | import :: c_ptr, c_size_t 47 | implicit none 48 | type(c_ptr), intent(in), value :: str 49 | integer(kind=c_size_t) :: c_strlen 50 | end function c_strlen 51 | end interface 52 | end module unix_string 53 | -------------------------------------------------------------------------------- /src/unix_syslog.F90: -------------------------------------------------------------------------------- 1 | ! unix_syslog.F90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | module unix_syslog 6 | use, intrinsic :: iso_c_binding 7 | implicit none 8 | private 9 | 10 | integer(kind=c_int), parameter, public :: LOG_EMERG = 0 ! system is unusable 11 | integer(kind=c_int), parameter, public :: LOG_ALERT = 1 ! action must be taken immediately 12 | integer(kind=c_int), parameter, public :: LOG_CRIT = 2 ! critical conditions 13 | integer(kind=c_int), parameter, public :: LOG_ERR = 3 ! error conditions 14 | integer(kind=c_int), parameter, public :: LOG_WARNING = 4 ! warning conditions 15 | integer(kind=c_int), parameter, public :: LOG_NOTICE = 5 ! normal but significant condition 16 | integer(kind=c_int), parameter, public :: LOG_INFO = 6 ! informational 17 | integer(kind=c_int), parameter, public :: LOG_DEBUG = 7 ! debug-level messages 18 | 19 | integer(kind=c_int), parameter, public :: LOG_KERN = shiftl( 0, 3) ! kernel messages 20 | integer(kind=c_int), parameter, public :: LOG_USER = shiftl( 1, 3) ! random user-level messages 21 | integer(kind=c_int), parameter, public :: LOG_MAIL = shiftl( 2, 3) ! mail system 22 | integer(kind=c_int), parameter, public :: LOG_DAEMON = shiftl( 3, 3) ! system daemons 23 | integer(kind=c_int), parameter, public :: LOG_AUTH = shiftl( 4, 3) ! security/authorization messages 24 | integer(kind=c_int), parameter, public :: LOG_SYSLOG = shiftl( 5, 3) ! messages generated internally by syslogd 25 | integer(kind=c_int), parameter, public :: LOG_LPR = shiftl( 6, 3) ! line printer subsystem 26 | integer(kind=c_int), parameter, public :: LOG_NEWS = shiftl( 7, 3) ! network news subsystem 27 | integer(kind=c_int), parameter, public :: LOG_UUCP = shiftl( 8, 3) ! UUCP subsystem 28 | integer(kind=c_int), parameter, public :: LOG_CRON = shiftl( 9, 3) ! clock daemon 29 | integer(kind=c_int), parameter, public :: LOG_AUTHPRIV = shiftl(10, 3) ! security/authorization messages (private) 30 | integer(kind=c_int), parameter, public :: LOG_FTP = shiftl(11, 3) ! ftp daemon 31 | 32 | #if defined (__FreeBSD__) 33 | 34 | integer(kind=c_int), parameter, public :: LOG_NTP = shiftl(12, 3) ! NTP subsystem 35 | integer(kind=c_int), parameter, public :: LOG_SECURITY = shiftl(13, 3) ! security subsystems (firewalling, etc.) 36 | integer(kind=c_int), parameter, public :: LOG_CONSOLE = shiftl(14, 3) ! /dev/console output 37 | 38 | #endif 39 | 40 | integer(kind=c_int), parameter, public :: LOG_PID = int(z'01') ! log the pid with each message 41 | integer(kind=c_int), parameter, public :: LOG_CONS = int(z'02') ! log on the console if errors in sending 42 | integer(kind=c_int), parameter, public :: LOG_ODELAY = int(z'04') ! delay open until first syslog() (default) 43 | integer(kind=c_int), parameter, public :: LOG_NDELAY = int(z'08') ! don't delay open 44 | integer(kind=c_int), parameter, public :: LOG_NOWAIT = int(z'10') ! don't wait for console forks: DEPRECATED 45 | integer(kind=c_int), parameter, public :: LOG_PERROR = int(z'20') ! log to stderr as well 46 | 47 | public :: c_closelog 48 | public :: c_openlog 49 | public :: c_syslog 50 | 51 | interface 52 | ! void closelog(void) 53 | subroutine c_closelog() bind(c, name='closelog') 54 | end subroutine c_closelog 55 | 56 | ! void openlog(const char *ident, int option, int facility) 57 | subroutine c_openlog(ident, option, facility) bind(c, name='openlog') 58 | import :: c_char, c_int 59 | implicit none 60 | character(kind=c_char), intent(in) :: ident 61 | integer(kind=c_int), intent(in), value :: option 62 | integer(kind=c_int), intent(in), value :: facility 63 | end subroutine c_openlog 64 | 65 | ! void syslog(int priority, const char *format, ...) 66 | subroutine c_syslog(priority, format, str) bind(c, name='c_syslog') 67 | import :: c_char, c_int 68 | implicit none 69 | integer(kind=c_int), intent(in), value :: priority 70 | character(kind=c_char), intent(in) :: format 71 | character(kind=c_char), intent(in) :: str 72 | end subroutine c_syslog 73 | end interface 74 | end module unix_syslog 75 | -------------------------------------------------------------------------------- /src/unix_time.F90: -------------------------------------------------------------------------------- 1 | ! unix_time.F90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | module unix_time 6 | use, intrinsic :: iso_c_binding 7 | use :: unix_types 8 | implicit none 9 | private 10 | 11 | #if defined (__linux__) 12 | 13 | integer(kind=c_int), parameter, public :: CLOCK_REALTIME = 0 14 | integer(kind=c_int), parameter, public :: CLOCK_MONOTONIC = 1 15 | integer(kind=c_int), parameter, public :: CLOCK_PROCESS_CPUTIME_ID = 2 16 | integer(kind=c_int), parameter, public :: CLOCK_THREAD_CPUTIME_ID = 3 17 | integer(kind=c_int), parameter, public :: CLOCK_MONOTONIC_RAW = 4 18 | integer(kind=c_int), parameter, public :: CLOCK_REALTIME_COARSE = 5 19 | integer(kind=c_int), parameter, public :: CLOCK_MONOTONIC_COARSE = 6 20 | integer(kind=c_int), parameter, public :: CLOCK_BOOTTIME = 7 21 | integer(kind=c_int), parameter, public :: CLOCK_REALTIME_ALARM = 8 22 | integer(kind=c_int), parameter, public :: CLOCK_BOOTTIME_ALARM = 9 23 | integer(kind=c_int), parameter, public :: CLOCK_TAI = 11 24 | 25 | integer(kind=c_int), parameter, public :: TIMER_ABSTIME = 1 26 | 27 | #elif defined (__FreeBSD__) 28 | 29 | integer(kind=c_int), parameter, public :: CLOCK_REALTIME = 0 30 | integer(kind=c_int), parameter, public :: CLOCK_VIRTUAL = 1 31 | integer(kind=c_int), parameter, public :: CLOCK_PROF = 2 32 | integer(kind=c_int), parameter, public :: CLOCK_MONOTONIC = 4 33 | integer(kind=c_int), parameter, public :: CLOCK_UPTIME = 5 34 | integer(kind=c_int), parameter, public :: CLOCK_UPTIME_PRECISE = 7 35 | integer(kind=c_int), parameter, public :: CLOCK_UPTIME_FAST = 8 36 | integer(kind=c_int), parameter, public :: CLOCK_REALTIME_PRECISE = 9 37 | integer(kind=c_int), parameter, public :: CLOCK_REALTIME_FAST = 10 38 | integer(kind=c_int), parameter, public :: CLOCK_MONOTONIC_PRECISE = 11 39 | integer(kind=c_int), parameter, public :: CLOCK_MONOTONIC_FAST = 12 40 | integer(kind=c_int), parameter, public :: CLOCK_SECOND = 13 41 | integer(kind=c_int), parameter, public :: CLOCK_THREAD_CPUTIME_ID = 14 42 | integer(kind=c_int), parameter, public :: CLOCK_PROCESS_CPUTIME_ID = 15 43 | 44 | integer(kind=c_int), parameter, public :: TIMER_RELTIME = 0 45 | integer(kind=c_int), parameter, public :: TIMER_ABSTIME = 1 46 | 47 | #endif 48 | 49 | ! struct timespec 50 | type, bind(c), public :: c_timespec 51 | integer(kind=c_time_t) :: tv_sec = 0_c_time_t 52 | integer(kind=c_long) :: tv_nsec = 0_c_long 53 | end type c_timespec 54 | 55 | ! struct timeval 56 | type, bind(c), public :: c_timeval 57 | integer(kind=c_time_t) :: tv_sec = 0_c_time_t 58 | integer(kind=c_suseconds_t) :: tv_usec = 0_c_suseconds_t 59 | end type c_timeval 60 | 61 | ! struct timezone 62 | type, bind(c), public :: c_timezone 63 | integer(kind=c_int) :: tz_minuteswest = 0 ! Minutes west of Greenwich. 64 | integer(kind=c_int) :: tz_dsttime = 0 ! Type of DST correction. 65 | end type c_timezone 66 | 67 | ! struct tm 68 | type, bind(c), public :: c_tm 69 | integer(kind=c_int) :: tm_sec = 0 ! Seconds after minute (0 - 59). 70 | integer(kind=c_int) :: tm_min = 0 ! Minutes after hour (0 - 59). 71 | integer(kind=c_int) :: tm_hour = 0 ! Hours since midnight (0 - 23). 72 | integer(kind=c_int) :: tm_mday = 0 ! Day of month (1 - 31). 73 | integer(kind=c_int) :: tm_mon = 0 ! Month (0 - 11). 74 | integer(kind=c_int) :: tm_year = 0 ! Year (current year minus 1900). 75 | integer(kind=c_int) :: tm_wday = 0 ! Day of week (0 - 6; Sunday = 0). 76 | integer(kind=c_int) :: tm_yday = 0 ! Day of year (0 - 365). 77 | integer(kind=c_int) :: tm_isdst = 0 ! Positive if daylight saving time is in effect. 78 | integer(kind=c_long) :: tm_gmtoff = 0_c_long ! Offset from UTC in seconds. 79 | type(c_ptr) :: tm_zone = c_null_ptr ! Abbreviation of timezone name (const char *). 80 | end type c_tm 81 | 82 | public :: c_asctime 83 | public :: c_clock_gettime 84 | public :: c_ctime 85 | public :: c_gettimeofday 86 | public :: c_gmtime 87 | public :: c_gmtime_r 88 | public :: c_localtime 89 | public :: c_localtime_r 90 | public :: c_mktime 91 | public :: c_strftime 92 | public :: c_time 93 | public :: c_timegm 94 | 95 | interface 96 | ! char *asctime(const struct tm *timeptr) 97 | function c_asctime(timeptr) bind(c, name='asctime') 98 | import :: c_ptr, c_tm 99 | implicit none 100 | type(c_tm), intent(in) :: timeptr 101 | type(c_ptr) :: c_asctime 102 | end function c_asctime 103 | 104 | ! int clock_gettime(clockid_t clk_id, struct timespec *tp) 105 | function c_clock_gettime(clk_id, tp) bind(c, name='clock_gettime') 106 | import :: c_clockid_t, c_int, c_timespec 107 | implicit none 108 | integer(kind=c_clockid_t), intent(in), value :: clk_id 109 | type(c_timespec), intent(out) :: tp 110 | integer(kind=c_int) :: c_clock_gettime 111 | end function c_clock_gettime 112 | 113 | ! char *ctime(const time_t *clock) 114 | function c_ctime(clock) bind(c, name='ctime') 115 | import :: c_ptr, c_time_t 116 | integer(kind=c_time_t), intent(in) :: clock 117 | type(c_ptr) :: c_ctime 118 | end function c_ctime 119 | 120 | ! int gettimeofday(struct timeval *tv, struct timezone *tz) 121 | function c_gettimeofday(tv, tz) bind(c, name='gettimeofday') 122 | import :: c_int, c_timeval, c_timezone 123 | implicit none 124 | type(c_timeval), intent(out) :: tv 125 | type(c_timezone), intent(in) :: tz 126 | integer(kind=c_int) :: c_gettimeofday 127 | end function c_gettimeofday 128 | 129 | ! struct tm *gmtime(const time_t *timer) 130 | function c_gmtime(timer) bind(c, name='gmtime') 131 | import :: c_ptr, c_time_t 132 | implicit none 133 | integer(kind=c_time_t), intent(in) :: timer 134 | type(c_ptr) :: c_gmtime 135 | end function c_gmtime 136 | 137 | ! struct tm *gmtime_r(const time_t *timer, struct tm *result) 138 | function c_gmtime_r(timer, result) bind(c, name='gmtime_r') 139 | import :: c_ptr, c_time_t, c_tm 140 | implicit none 141 | integer(kind=c_time_t), intent(in) :: timer 142 | type(c_tm), intent(inout) :: result 143 | type(c_ptr) :: c_gmtime_r 144 | end function c_gmtime_r 145 | 146 | ! struct tm *localtime(const time_t *timer) 147 | function c_localtime(timer) bind(c, name='localtime') 148 | import :: c_ptr, c_time_t 149 | implicit none 150 | integer(kind=c_time_t), intent(in) :: timer 151 | type(c_ptr) :: c_localtime 152 | end function c_localtime 153 | 154 | ! struct tm *localtime_r(const time_t *timer, struct tm *result) 155 | function c_localtime_r(timer, result) bind(c, name='localtime_r') 156 | import :: c_ptr, c_time_t, c_tm 157 | implicit none 158 | integer(kind=c_time_t), intent(in) :: timer 159 | type(c_tm), intent(inout) :: result 160 | type(c_ptr) :: c_localtime_r 161 | end function c_localtime_r 162 | 163 | ! time_t mktime(struct tm *tm) 164 | function c_mktime(tm) bind(c, name='mktime') 165 | import :: c_time_t, c_tm 166 | implicit none 167 | type(c_tm), intent(inout) :: tm 168 | integer(kind=c_time_t) :: c_mktime 169 | end function c_mktime 170 | 171 | ! size_t strftime(char *s, size_t max, const char *format, const struct tm *tm) 172 | function c_strftime(s, max, format, tm) bind(c, name='strftime') 173 | import :: c_char, c_size_t, c_tm 174 | implicit none 175 | character(kind=c_char), intent(in) :: s 176 | integer(kind=c_size_t), intent(in), value :: max 177 | character(kind=c_char), intent(in) :: format 178 | type(c_tm), intent(in) :: tm 179 | integer(kind=c_size_t) :: c_strftime 180 | end function c_strftime 181 | 182 | ! time_t time(time_t *tloc) 183 | function c_time(tloc) bind(c, name='time') 184 | import :: c_time_t 185 | implicit none 186 | integer(kind=c_time_t), intent(in), value :: tloc 187 | integer(kind=c_time_t) :: c_time 188 | end function c_time 189 | 190 | ! time_t timegm(struct tm *tm) 191 | function c_timegm(tm) bind(c, name='timegm') 192 | import :: c_time_t, c_tm 193 | implicit none 194 | type(c_tm), intent(in) :: tm 195 | integer(kind=c_time_t) :: c_timegm 196 | end function c_timegm 197 | end interface 198 | end module unix_time 199 | -------------------------------------------------------------------------------- /src/unix_types.F90: -------------------------------------------------------------------------------- 1 | ! unix_types.F90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | module unix_types 6 | use, intrinsic :: iso_c_binding 7 | implicit none 8 | private 9 | 10 | #if defined (__flang__) || (defined (__GFORTRAN__) && __GNUC__ >= 15 && __GNUC_MINOR__ >= 1) 11 | 12 | public :: c_uint16_t 13 | public :: c_uint32_t 14 | public :: c_uint64_t 15 | 16 | public :: c_unsigned 17 | public :: c_unsigned_char 18 | public :: c_unsigned_short 19 | public :: c_unsigned_long 20 | 21 | #else 22 | 23 | integer, parameter, public :: c_uint16_t = c_int16_t 24 | integer, parameter, public :: c_uint32_t = c_int32_t 25 | integer, parameter, public :: c_uint64_t = c_int64_t 26 | 27 | integer, parameter, public :: c_unsigned = c_int 28 | integer, parameter, public :: c_unsigned_char = c_signed_char 29 | integer, parameter, public :: c_unsigned_short = c_short 30 | integer, parameter, public :: c_unsigned_long = c_long 31 | 32 | #endif 33 | 34 | #if defined (__linux__) 35 | 36 | integer, parameter, public :: c_blkcnt_t = c_int64_t 37 | integer, parameter, public :: c_blksize_t = c_long 38 | integer, parameter, public :: c_cc_t = c_unsigned_char 39 | integer, parameter, public :: c_clockid_t = c_int32_t 40 | integer, parameter, public :: c_dev_t = c_unsigned_long 41 | integer, parameter, public :: c_gid_t = c_uint32_t 42 | integer, parameter, public :: c_in_addr_t = c_uint32_t 43 | integer, parameter, public :: c_ino_t = c_unsigned_long 44 | integer, parameter, public :: c_key_t = c_long 45 | integer, parameter, public :: c_mode_t = c_uint32_t 46 | integer, parameter, public :: c_mqd_t = c_int 47 | integer, parameter, public :: c_nlink_t = c_unsigned_long 48 | integer, parameter, public :: c_off_t = c_long 49 | integer, parameter, public :: c_pid_t = c_int32_t 50 | integer, parameter, public :: c_regoff_t = c_size_t 51 | integer, parameter, public :: c_socklen_t = c_int64_t 52 | integer, parameter, public :: c_speed_t = c_unsigned 53 | integer, parameter, public :: c_suseconds_t = c_int 54 | integer, parameter, public :: c_tcflag_t = c_unsigned 55 | integer, parameter, public :: c_time_t = c_long 56 | integer, parameter, public :: c_uid_t = c_uint32_t 57 | integer, parameter, public :: c_useconds_t = c_int32_t 58 | 59 | #elif defined (__FreeBSD__) 60 | 61 | integer, parameter, public :: c_blkcnt_t = c_int64_t 62 | integer, parameter, public :: c_blksize_t = c_int32_t 63 | integer, parameter, public :: c_cc_t = c_unsigned_char 64 | integer, parameter, public :: c_clockid_t = c_int32_t 65 | integer, parameter, public :: c_dev_t = c_uint64_t 66 | integer, parameter, public :: c_fflags_t = c_uint32_t 67 | integer, parameter, public :: c_gid_t = c_uint32_t 68 | integer, parameter, public :: c_in_addr_t = c_uint32_t 69 | integer, parameter, public :: c_ino_t = c_uint64_t 70 | integer, parameter, public :: c_key_t = c_long 71 | integer, parameter, public :: c_mode_t = c_uint16_t 72 | integer, parameter, public :: c_mqd_t = c_long 73 | integer, parameter, public :: c_nlink_t = c_uint64_t 74 | integer, parameter, public :: c_off_t = c_int64_t 75 | integer, parameter, public :: c_pid_t = c_int32_t 76 | integer, parameter, public :: c_regoff_t = c_int64_t 77 | integer, parameter, public :: c_socklen_t = c_size_t 78 | integer, parameter, public :: c_speed_t = c_unsigned 79 | integer, parameter, public :: c_suseconds_t = c_long 80 | integer, parameter, public :: c_tcflag_t = c_unsigned 81 | integer, parameter, public :: c_time_t = c_int64_t 82 | integer, parameter, public :: c_uid_t = c_uint32_t 83 | integer, parameter, public :: c_useconds_t = c_unsigned 84 | 85 | #endif 86 | end module unix_types 87 | -------------------------------------------------------------------------------- /src/unix_unistd.F90: -------------------------------------------------------------------------------- 1 | ! unix_unistd.F90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | module unix_unistd 6 | use, intrinsic :: iso_c_binding 7 | use :: unix_types 8 | implicit none 9 | private 10 | 11 | integer(kind=c_int), parameter, public :: STDIN_FILENO = 0 12 | integer(kind=c_int), parameter, public :: STDOUT_FILENO = 1 13 | integer(kind=c_int), parameter, public :: STDERR_FILENO = 2 14 | 15 | integer(kind=c_int), parameter, public :: F_OK = 0 ! Test for existence of file. 16 | integer(kind=c_int), parameter, public :: X_OK = int(z'01') ! Test for execute or search permission. 17 | integer(kind=c_int), parameter, public :: W_OK = int(z'02') ! Test for write permission. 18 | integer(kind=c_int), parameter, public :: R_OK = int(z'04') ! Test for read permission. 19 | 20 | public :: c_access 21 | public :: c_chdir 22 | public :: c_close 23 | public :: c_dup 24 | public :: c_dup2 25 | public :: c_execl 26 | public :: c_faccessat 27 | public :: c_fork 28 | public :: c_getpid 29 | public :: c_pipe 30 | public :: c_read 31 | public :: c_setsid 32 | public :: c_unlink 33 | public :: c_usleep 34 | public :: c_write 35 | 36 | interface 37 | ! int access(const char *path, int mode) 38 | function c_access(path, mode) bind(c, name='access') 39 | import :: c_char, c_int 40 | implicit none 41 | character(kind=c_char), intent(in) :: path 42 | integer(kind=c_int), intent(in), value :: mode 43 | integer(kind=c_int) :: c_access 44 | end function c_access 45 | 46 | ! int chdir(const char *path) 47 | function c_chdir(path) bind(c, name='chdir') 48 | import :: c_int, c_char 49 | implicit none 50 | character(kind=c_char), intent(in) :: path 51 | integer(kind=c_int) :: c_chdir 52 | end function c_chdir 53 | 54 | ! int close(int fd) 55 | function c_close(fd) bind(c, name='close') 56 | import :: c_int 57 | implicit none 58 | integer(kind=c_int), intent(in), value :: fd 59 | integer(kind=c_int) :: c_close 60 | end function c_close 61 | 62 | ! int dup(int oldfd) 63 | function c_dup(old_fd) bind(c, name='dup') 64 | import :: c_int 65 | implicit none 66 | integer(kind=c_int), intent(in), value :: old_fd 67 | integer(kind=c_int) :: c_dup 68 | end function c_dup 69 | 70 | ! int dup2(int oldfd, int newfd) 71 | function c_dup2(old_fd, new_fd) bind(c, name='dup2') 72 | import :: c_int 73 | implicit none 74 | integer(kind=c_int), intent(in), value :: old_fd 75 | integer(kind=c_int), intent(in), value :: new_fd 76 | integer(kind=c_int) :: c_dup2 77 | end function c_dup2 78 | 79 | ! int execl(const char *path, const char *arg, ...) 80 | function c_execl(path, arg1, arg2, arg3, ptr) bind(c, name='c_execl') 81 | import :: c_char, c_int, c_ptr 82 | implicit none 83 | character(kind=c_char), intent(in) :: path 84 | character(kind=c_char), intent(in) :: arg1 85 | character(kind=c_char), intent(in) :: arg2 86 | character(kind=c_char), intent(in) :: arg3 87 | type(c_ptr), intent(in), value :: ptr 88 | integer(kind=c_int) :: c_execl 89 | end function c_execl 90 | 91 | ! int faccessat(int dirfd, const char *path, int mode, int flags) 92 | function c_faccessat(dirfd, path, mode, flags) bind(c, name='faccessat') 93 | import :: c_char, c_int 94 | implicit none 95 | integer(kind=c_int), intent(in), value :: dirfd 96 | character(kind=c_char), intent(in) :: path 97 | integer(kind=c_int), intent(in), value :: mode 98 | integer(kind=c_int), intent(in), value :: flags 99 | integer(kind=c_int) :: c_faccessat 100 | end function c_faccessat 101 | 102 | ! pid_t fork(void) 103 | function c_fork() bind(c, name='fork') 104 | import :: c_pid_t 105 | implicit none 106 | integer(kind=c_pid_t) :: c_fork 107 | end function c_fork 108 | 109 | ! pid_t fork(void) 110 | function c_getpid() bind(c, name='getpid') 111 | import :: c_pid_t 112 | implicit none 113 | integer(kind=c_pid_t) :: c_getpid 114 | end function c_getpid 115 | 116 | ! int pipe(int fd[2]) 117 | function c_pipe(fd) bind(c, name='pipe') 118 | import :: c_int 119 | implicit none 120 | integer(kind=c_int), intent(in) :: fd(2) 121 | integer(kind=c_int) :: c_pipe 122 | end function c_pipe 123 | 124 | ! ssize_t read(int fd, void *buf, size_t nbyte) 125 | function c_read(fd, buf, nbyte) bind(c, name='read') 126 | import :: c_int, c_ptr, c_size_t 127 | implicit none 128 | integer(kind=c_int), intent(in), value :: fd 129 | type(c_ptr), intent(in), value :: buf 130 | integer(kind=c_size_t), intent(in), value :: nbyte 131 | integer(kind=c_size_t) :: c_read 132 | end function c_read 133 | 134 | ! pid_t setsid(void) 135 | function c_setsid() bind(c, name='setsid') 136 | import :: c_pid_t 137 | implicit none 138 | integer(kind=c_pid_t) :: c_setsid 139 | end function c_setsid 140 | 141 | ! int unlink(const char *path) 142 | function c_unlink(path) bind(c, name='unlink') 143 | import :: c_char, c_int 144 | implicit none 145 | character(kind=c_char), intent(in) :: path 146 | integer(kind=c_int) :: c_unlink 147 | end function c_unlink 148 | 149 | ! int usleep(useconds_t useconds) 150 | function c_usleep(useconds) bind(c, name='usleep') 151 | import :: c_int, c_useconds_t 152 | implicit none 153 | integer(kind=c_useconds_t), value :: useconds 154 | integer(kind=c_int) :: c_usleep 155 | end function c_usleep 156 | 157 | ! ssize_t write(int fd, void *buf, size_t nbyte) 158 | function c_write(fd, buf, nbyte) bind(c, name='write') 159 | import :: c_int, c_size_t, c_ptr 160 | implicit none 161 | integer(kind=c_int), intent(in), value :: fd 162 | type(c_ptr), intent(in), value :: buf 163 | integer(kind=c_size_t), intent(in), value :: nbyte 164 | integer(kind=c_size_t) :: c_write 165 | end function c_write 166 | end interface 167 | end module unix_unistd 168 | -------------------------------------------------------------------------------- /src/unix_utsname.F90: -------------------------------------------------------------------------------- 1 | ! unix_utsname.F90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | module unix_utsname 6 | use, intrinsic :: iso_c_binding 7 | implicit none 8 | private 9 | 10 | #if defined (__linux__) 11 | 12 | integer(kind=c_int), parameter, public :: SYS_NMLN = 65 13 | 14 | ! struct utsname 15 | type, bind(c), public :: c_utsname 16 | character(kind=c_char) :: sysname(0:SYS_NMLN - 1) = c_null_char 17 | character(kind=c_char) :: nodename(0:SYS_NMLN - 1) = c_null_char 18 | character(kind=c_char) :: release(0:SYS_NMLN - 1) = c_null_char 19 | character(kind=c_char) :: version(0:SYS_NMLN - 1) = c_null_char 20 | character(kind=c_char) :: machine(0:SYS_NMLN - 1) = c_null_char 21 | character(kind=c_char) :: domainname(0:SYS_NMLN - 1) = c_null_char 22 | end type c_utsname 23 | 24 | #elif defined (__FreeBSD__) 25 | 26 | integer(kind=c_int), parameter, public :: SYS_NMLN = 256 27 | 28 | ! struct utsname 29 | type, bind(c), public :: c_utsname 30 | character(kind=c_char) :: sysname(0:SYS_NMLN - 1) = c_null_char 31 | character(kind=c_char) :: nodename(0:SYS_NMLN - 1) = c_null_char 32 | character(kind=c_char) :: release(0:SYS_NMLN - 1) = c_null_char 33 | character(kind=c_char) :: version(0:SYS_NMLN - 1) = c_null_char 34 | character(kind=c_char) :: machine(0:SYS_NMLN - 1) = c_null_char 35 | end type c_utsname 36 | 37 | #endif 38 | 39 | public :: c_uname 40 | 41 | interface 42 | ! int uname(struct utsname *name) 43 | function c_uname(name) bind(c, name='c_uname') 44 | !! Calls wrapper `c_uname()` in `unix_macro.c`, as it is an inline 45 | !! function on FreeBSD, alternatively to calling `__xuname()`. 46 | import :: c_int, c_utsname 47 | implicit none 48 | type(c_utsname), intent(inout) :: name 49 | integer(kind=c_int) :: c_uname 50 | end function c_uname 51 | end interface 52 | end module unix_utsname 53 | -------------------------------------------------------------------------------- /src/unix_wait.F90: -------------------------------------------------------------------------------- 1 | ! unix_wait.F90 2 | ! 3 | ! Author: Philipp Engel 4 | ! Licence: ISC 5 | module unix_wait 6 | use, intrinsic :: iso_c_binding 7 | use :: unix_types 8 | implicit none 9 | private 10 | 11 | public :: c_wait 12 | 13 | interface 14 | ! pid_t wait(int *stat_loc) 15 | function c_wait(stat_loc) bind(c, name='wait') 16 | import :: c_int, c_pid_t 17 | implicit none 18 | integer(kind=c_int), intent(out) :: stat_loc 19 | integer(kind=c_pid_t) :: c_wait 20 | end function c_wait 21 | end interface 22 | end module unix_wait 23 | --------------------------------------------------------------------------------