Patch title: Release 94 bulk changes
Abstract:
File: /pliant/language/os/linux.pli
Key:
    Removed line
    Added line
# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License version 2
# as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# version 2 along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

scope "/pliant/language/"
module "/pliant/install/ring2.pli"


#----------------------------------------------------------------
#  testing the distribution


function os_compute_version -> version
  arg Str version
  var Int h := file_open "/proc/sys/kernel/osrelease" 1
  if h=-1
    return ""
  var Str buffer := repeat 80 " "
  var Int len := file_read h buffer:characters buffer:len
  version := buffer 0 len
  version := version 0 (version search "[lf]" version:len)
  file_close h

public
  constant os_version os_compute_version

constant yield_works true

function fake_utimes filename tv -> err
  arg Address filename tv ; arg Int err
  kernel_function 271

constant yield_works (fake_utimes null null)<>(-38) # Linux 2.6 or better


#----------------------------------------------------------------
#  processes

function os_clone flags stack -> pid
  arg Int flags pid ; arg Address stack
  kernel_function 120

function os_execve cmd args env -> err
  arg CStr cmd ; arg Address args env ; arg Int err
  kernel_function 11

function os_getpid -> pid
  arg Int pid
  kernel_function 20

# function os_getpgid pid -> gid
#   arg Int pid gid
#   kernel_function 132

function os_waitpid pid status options -> pid2
  arg Int pid pid2 ; arg_w Int status ; arg uInt options
  kernel_function 7

function os_setsid
  kernel_function 66

function os_setuid id -> err
  arg Int id err
  kernel_function 23

function os_getuid -> id
  arg Int id
  kernel_function 24

function os_setgid id -> err
  arg Int id err
  kernel_function 46

function os_getgid -> id
  arg Int id
  kernel_function 47

function os_exit retcode
  arg Int retcode
  kernel_function 1

export os_clone os_execve os_getpid os_waitpid os_setsid os_setuid os_setgid os_exit
export os_clone os_execve os_getpid os_waitpid os_setsid os_setuid os_getuid os_setgid os_getgid os_exit


#----------------------------------------------------------------
#  signals

public
  constant os_SIGHUP   1
  constant os_SIGINT   2
  constant os_SIGQUIT  3
  constant os_SIGABRT  6
  constant os_SIGBUS   7
  constant os_SIGFPE   8
  constant os_SIGKILL  9
  constant os_SIGUSR1  10
  constant os_SIGSEGV  11
  constant os_SIGUSR2  12
  constant os_SIGPIPE  13
  constant os_SIGALARM 14
  constant os_SIGTERM  15
  constant os_SIGCONT  18
  constant os_SIGSTOP  19

  constant os_SIG_IGN 1

public
  type os_sigaction
    packed
    field Address sa_handler
    field uInt sa_mask
    field Int sa_flags
    field Address sa_restorer

function build  sa
  arg_w os_sigaction sa
  memory_clear addressof:sa os_sigaction:size

function os_sigaction num newaction oldaction -> err
  arg Int num err ; arg os_sigaction newaction ; arg_w os_sigaction oldaction
  kernel_function 67

function os_sigsetmask mask
  arg uInt mask
  kernel_function 69

function os_sigsuspend drop1 drop2 mask
  arg uInt drop1 drop2 mask
  kernel_function 72

function os_kill pid sig
  arg Int pid sig
  kernel_function 37

export os_sigaction
export os_sigsetmask os_sigsuspend os_kill


#----------------------------------------------------------------
#  time

public
  type os_timespec
    packed
    field Int tv_sec tv_nsec

function os_nanosleep req rem
  arg os_timespec req ; arg_w os_timespec rem
  kernel_function 162
 
function os_yield
  if yield_works
    kernel_function 158
  else
    var os_timespec ts
    ts tv_sec := 0
    ts tv_nsec := 0
    os_nanosleep ts ts

function os_setpriority which who prio -> err
  arg Int which who prio err
  kernel_function 97

constant os_PRIO_PROCESS 0

export os_nanosleep os_yield os_setpriority os_PRIO_PROCESS


public
  type os_timeval
    packed
    field Int tv_sec tv_usec

  type os_timezone
    packed
    field Int tz_minuteswest
    field Int tz_dsttime

function os_gettimeofday tv tz
  arg_w os_timeval tv ; arg_w os_timezone tz
  kernel_function 78

function os_settimeofday tv tz
  arg os_timeval tv ; arg os_timezone tz
  kernel_function 79

export os_gettimeofday os_settimeofday


#----------------------------------------------------------------
#  files IO

function os_read handle address size -> err
  arg Int handle size err ; arg Address address
  kernel_function 3

function os_write handle address size -> err
  arg Int handle size err ; arg Address address
  kernel_function 4

function os_select n readfds writefds exceptfds timeout -> fd
  arg Int n ; arg Address readfds writefds exceptfds ; arg_rw os_timeval timeout ; arg Int fd
  kernel_function 142

public
  type os_pollfd
    field Int fd
    field uInt16 events revents
  constant os_POLLIN 1
  constant os_POLLOUT 4
  constant os_POLLERR 8
  constant os_POLLHUP 16
  constant os_POLLNVAL 20


function os_poll fds nfds timeout -> count
  arg Address fds ; arg Int nfds timeout ; arg Int count
  kernel_function 168

public
  constant os_EAGAIN     11

public
  constant os_O_RDONLY   0
  constant os_O_WRONLY   1
  constant os_O_RDWR     2
  constant os_O_CREAT    1*8^2
  constant os_O_NOCTTY   4*8^2
  constant os_O_TRUNC    1*8^3
  constant os_O_APPEND   2*8^3
  constant os_O_NONBLOCK 4*8^3
  constant os_O_LARGEFILE 1*8^5

public
  constant os_F_SETFL    4

function os_open name flags rights -> handle
  arg CStr name ; arg Int flags rights handle
  kernel_function 5

function os_close handle -> err
  arg Int handle err
  kernel_function 6

function os_ioctl handle request param -> answer
  arg Int handle ; arg uInt request ; arg Address param ; arg Int answer
  kernel_function 54

function os_fcntl handle cmd arg -> answer
  arg Int handle cmd arg answer
  kernel_function 55

public
  constant os_F_SETFD 2
  constant os_FD_CLOEXEC 1

public
  constant os_SEEK_SET 0
  constant os_SEEK_CUR 1
  constant os_SEEK_END 2

function os_lseek handle offset whence -> new_offset
  arg Int handle offset whence new_offset
  kernel_function 19

function os_llseek handle high low result whence -> err
  arg Int handle ; arg uInt high low ; arg Address result ; arg Int whence ; arg Int err
  kernel_function 140

function os_fsync handle -> err
  arg Int handle err
  kernel_function 118

function os_sync -> err
  arg Int err
  kernel_function 36

public
  type os_pipe_handles
    field Int in out

function os_pipe handles -> err
  arg_w os_pipe_handles handles ; arg Int err
  kernel_function 42

function os_dup src -> dest
  arg Int src dest
  kernel_function 41

function os_dup2 src dest -> newone
  arg Int src dest newone
  kernel_function 63

function os_chdir path -> err
  arg CStr path ; arg Int err
  kernel_function 12

function os_chroot path -> err
  arg CStr path ; arg Int err
  kernel_function 61


function os_link src dest -> err
  arg CStr src dest ; arg Int err
  kernel_function 9

function os_symlink src dest -> err
  arg CStr src dest ; arg Int err
  kernel_function 83

function os_unlink name -> err
  arg CStr name ; arg Int err
  kernel_function 10

function os_rename oldpath newpath -> err
  arg CStr oldpath newpath ; arg Int err
  kernel_function 38

function os_chmod name rights -> err
  arg CStr name ; arg Int rights err
  kernel_function 15

function os_lchown name uid gid -> err
  arg CStr name ; arg Int uid gid err
  kernel_function 16

public
  type os_utimbuf
    packed
    field uInt32 actime modtime

function os_utime name buf -> err
  arg CStr name ; arg os_utimbuf buf ; arg Int err
  kernel_function 30

function os_mkdir name mode -> err
  arg CStr name ; arg Int mode err
  kernel_function 39

function os_rmdir name -> err
  arg CStr name ; arg Int err
  kernel_function 40


public
  type os_stat
    packed
    field uInt16 st_dev __pad1
    field uInt st_ino
    field uInt16 st_mode 
    field uInt16 st_nlink
    field uInt16 st_uid st_gid
    field uInt16 st_rdev __pad2
    field uInt st_size st_blksize st_blocks
    field uInt st_atime __unused1 st_mtime __unused2 st_ctime
    field uInt __unused3 __unused4 __unused5
  
constant os_S_IFMT  0F000h
constant os_S_IFDIR 04000h
constant os_S_IFLNK 0A000h

function os_S_ISDIR mode -> dir
  arg Int mode ; arg CBool dir
  dir := (mode .and. os_S_IFMT)=os_S_IFDIR

function os_S_ISLNK mode -> dir
  arg Int mode ; arg CBool dir
  dir := (mode .and. os_S_IFMT)=os_S_IFLNK

export os_S_ISDIR os_S_ISLNK

function os_stat filename stat -> err
  arg CStr filename ; arg_w os_stat stat ; arg Int err
  kernel_function 106

function os_lstat filename stat -> err
  arg CStr filename ; arg_w os_stat stat ; arg Int err
  kernel_function 107

public
  type os_dirent
    field Int d_ino
    field Int d_off
    field uInt16 d_reclen
    field (Array Char 256) d_name

function os_getdents fd dirp count -> size
  arg Int fd ; arg Address dirp ; arg Int count size
  kernel_function 141 

function os_readlink path buf bufsize -> size
  arg CStr path ; arg Address buf ; arg Int bufsize size
  kernel_function 85


public
  constant os_default_directory_mode 7*8^2+5*8+5
  constant os_default_file_mode 6*8^2+4*8+4

export os_open os_ioctl os_fcntl os_read os_write os_select os_poll os_close os_lseek os_llseek
export os_fsync os_sync os_pipe os_dup os_dup2 os_chdir os_chroot
export os_link os_symlink os_unlink os_rename os_chmod os_lchown
export os_utime os_mkdir os_rmdir
export os_stat os_lstat os_getdents os_readlink


#----------------------------------------------------------------
#  memory

public
  constant os_PROT_READ  1
  constant os_PROT_WRITE 2
  constant os_PROT_EXEC  4

public
  constant os_MAP_SHARED     01h
  constant os_MAP_PRIVATE    02h
  constant os_MAP_FIXED      10h
  constant os_MAP_ANONYMOUS  20h
  constant os_MAP_GROWSDOWN  0100h
  constant os_MAP_DENYWRITE  0800h
  constant os_MAP_EXECUTABLE 1000h
  constant os_MAP_LOCKED     2000h

type os_MmapRequest
  packed
  field Address map_at_address
  field Int size prot flags
  field Int file_handle file_offset

function os_mmap1 req -> adr
  arg os_MmapRequest req ; arg Address adr
  kernel_function 90

function os_mmap map_at_address size prot flags file_handle file_offset -> adr
  arg Address map_at_address adr ; arg Int size prot flags file_handle file_offset
  var os_MmapRequest req
  req map_at_address := map_at_address
  req size := size
  req prot := prot
  req flags := flags
  req file_handle := file_handle
  req file_offset := file_offset
  adr := os_mmap1 req

function os_munmap adr size
  arg Address adr ; arg Int size
  kernel_function 91

export os_mmap os_munmap


#----------------------------------------------------------------
#  system informations

public
  type os_sysinfo
    packed
    field Int uptime
    field uInt load1 load5 load15
    field uInt totalram freeram sharedram bufferram
    field uInt totalswap freeswap
    field uInt16 procs pack1
    field Int drop1 drop2 drop3 drop4 drop5

function os_sysinfo info
  arg_rw os_sysinfo info
  kernel_function 116
  
export os_sysinfo


#----------------------------------------------------------------
#  testing the distribution


function libc_filename -> filename
  arg Str filename
  var os_stat buf ; var Int err
  if (os_extra_info parse any word:"static" any)
    filename := ""
  eif (os_extra_info search "libc6" -1)<>(-1) and (os_stat "/lib/libc.so.6" buf)=0
    filename := "/lib/libc.so.6"
  eif (os_stat "/lib/libc.so.5" buf)=0
    filename := "/lib/libc.so.5"
  else
    filename := ""
    if pliant_debugging_level_variable=0
      console "This is the static version of Pliant: it cannot use external functions.[lf]"

function zlib_filename -> filename
  arg Str filename
  var os_stat buf ; var Int err
  if (os_extra_info parse any word:"static" any)
    filename := ""
  eif (os_stat "/lib/libz.so" buf)=0
    filename := "/lib/libz.so"
  eif (os_stat "/usr/lib/libz.so" buf)=0
    filename := "/usr/lib/libz.so"
  eif (os_stat "/lib/libz.so.2" buf)=0
    filename := "/lib/libz.so.2"
  eif (os_stat "/usr/lib/libz.so.2" buf)=0
    filename := "/usr/lib/libz.so.2"
  eif (os_stat "/lib/libz.so.2.0" buf)=0
    filename := "/lib/libz.so.2.0"
  eif (os_stat "/usr/lib/libz.so.2.0" buf)=0
    filename := "/usr/lib/libz.so.2.0"
  eif (os_stat "/lib/libz.so.1" buf)=0
    filename := "/lib/libz.so.1"
  eif (os_stat "/usr/lib/libz.so.1" buf)=0
    filename := "/usr/lib/libz.so.1"
  eif (os_stat "/lib/libz.so.1.0" buf)=0
    filename := "/lib/libz.so.1.0"
  eif (os_stat "/usr/lib/libz.so.1.0" buf)=0
    filename := "/usr/lib/libz.so.1.0"
  else
    filename := ""

public
  constant os_libc_filename libc_filename
  constant os_zlib_filename zlib_filename