Patch title: Release 81 bulk changes
Abstract:
File: /pliant/language/os/win32.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"

public
  constant DUPLICATE_SAME_ACCESS 2

function os_DuplicateHandle src_process src_handle target_process target_handle access inherit options -> ok
  arg Int src_process src_handle target_process ; arg_w Int target_handle ; arg Int access ; arg CBool inherit ; arg Int options ; arg CBool ok
  external "kernel32.dll" "DuplicateHandle"

  
function os_CreateThread attributes stacksize routine parameter flags id -> handle
  arg Address attributes ; arg Int stacksize ; arg Address routine parameter ; arg Int flags ; arg_w Int id ; arg Int handle
  external "kernel32.dll" "CreateThread"
  
function os_GetCurrentThread -> handle
  arg Int handle
  external "kernel32.dll" "GetCurrentThread"
  
function os_SuspendThread handle -> count
  arg Int handle ; arg Int count
  external "kernel32.dll" "SuspendThread"
  
function os_ResumeThread handle -> count
  arg Int handle ; arg Int count
  external "kernel32.dll" "ResumeThread"
  
function os_TlsAlloc -> handle
  arg Int handle
  external "kernel32.dll" "TlsAlloc"  

function os_TlsSetValue handle value
  arg Int handle ; arg Address value
  external "kernel32.dll" "TlsSetValue"

function os_TlsGetValue handle -> value
  arg Int handle ; arg Address value
  external "kernel32.dll" "TlsGetValue"

function os_Sleep ms
  arg Int ms
  external "kernel32.dll" "Sleep"
  
public
  type os_SYSTEMTIME
    packed
    field uInt16 wYear wMonth wDayOfWeek wDay
    field uInt16 wHour wMinute wSecond wMilliseconds

function os_GetSystemTime t
  arg_w os_SYSTEMTIME t
  external "kernel32.dll" "GetSystemTime"
  
function os_yield
  os_Sleep 0  


function os_GetCurrentProcess -> handle
  arg Int handle
  external "kernel32.dll" "GetCurrentProcess"

function os_GetCurrentProcessId -> id
  arg Int id
  external "kernel32.dll" "GetCurrentProcessId"

function os_getpid -> id
  arg Int id
  id := os_GetCurrentProcessId
  
function os_ExitProcess retcode
  arg Int retcode
  external "kernel32.dll" "ExitProcess"
  
function os_exit retcode
  arg Int retcode
  os_ExitProcess retcode

function os_GetEnvironmentStrings -> env
  arg Address env
  external "kernel32.dll" "GetEnvironmentStrings"

function os_environment_variable name -> value
  arg Str name value
  var Address env := os_GetEnvironmentStrings
  var Int i := 0
  while true
    var Int j := i
    while ((env translate Char j) map Char):number<>0
      j := j+1
    if j=i
      return ""
    (var Str v) set (env translate Char i) j-i false
    var Int k := v search "=" -1
    if k<>(-1) and lower:(v 0 k)=lower:name
      return (v k+1 v:len)
    i := j+1

export os_DuplicateHandle
export os_CreateThread os_GetCurrentThread os_SuspendThread os_ResumeThread
export os_TlsAlloc os_TlsSetValue os_TlsGetValue
export os_Sleep os_GetSystemTime os_yield
export os_GetCurrentProcess os_GetCurrentProcessId os_getpid os_ExitProcess os_exit
export os_GetEnvironmentStrings os_environment_variable

function os_CreateFile name access share security creation flags template -> handle
  arg CStr name ; arg uInt access share ; arg Address security ; arg uInt creation flags ; arg Address template ; arg Int handle
  external "kernel32.dll" "CreateFileA"
  
function os_ReadFile handle buffer size red overlapped -> ok
  arg Int handle ; arg Address buffer ; arg Int size ; arg_w Int red ; arg Address overlapped ; arg CBool ok
  external "kernel32.dll" "ReadFile"
  
function os_WriteFile handle buffer size written overlapped -> ok
  arg Int handle ; arg Address buffer ; arg Int size ; arg_w Int written ; arg Address overlapped ; arg CBool ok
  external "kernel32.dll" "WriteFile"
  
function os_CloseHandle handle -> ok
  arg Int handle ; arg CBool ok
  external "kernel32.dll" "CloseHandle"
  
function os_SetFilePointer handle low high method -> pos
  arg Int handle ; arg uInt low ; arg_rw uInt high ; arg Int method; arg uInt pos
  external "kernel32.dll" "SetFilePointer"
  
function os_DeleteFile name -> ok
  arg CStr name ; arg CBool ok
  external "kernel32.dll" "DeleteFileA"
  
function os_CreateDirectory name security -> ok
  arg CStr name ; arg Address security ; arg CBool ok
  external "kernel32.dll" "CreateDirectoryA"
  
function os_RemoveDirectory name -> ok
  arg CStr name ; arg CBool ok
  external "kernel32.dll" "RemoveDirectoryA"

function os_GetStdHandle id -> handle
  arg Int id handle
  external "kernel32.dll" "GetStdHandle"

public
  constant os_GENERIC_READ     80000000h
  constant os_GENERIC_WRITE    40000000h
  constant os_FILE_SHARE_READ  00000001h
  constant os_FILE_SHARE_WRITE 00000002h
  constant os_CREATE_ALWAYS 2
  constant os_OPEN_EXISTING 3
  constant os_OPEN_ALWAYS 4
  constant os_FILE_ATTRIBUTE_NORMAL 80h
  constant os_FILE_FLAG_SEQUENTIAL_SCAN 08000000h
  constant os_FILE_FLAG_RANDOM_ACCESS   10000000h

  constant os_FILE_BEGIN 0
  constant os_FILE_CURRENT 1
  constant os_FILE_END 2

  constant os_STD_INPUT_HANDLE  -10
  constant os_STD_OUTPUT_HANDLE -11
  constant os_STD_ERROR_HANDLE  -12

export os_CreateFile os_ReadFile os_WriteFile os_CloseHandle os_SetFilePointer
export os_DeleteFile os_CreateDirectory os_RemoveDirectory
export os_GetStdHandle


function os_GetConsoleMode handle mode -> ok
  arg Int handle ; arg_w uInt mode ; arg CBool ok
  external "kernel32.dll" "GetConsoleMode"

function os_SetConsoleMode handle mode -> ok
  arg Int handle ; arg uInt mode ; arg CBool ok
  external "kernel32.dll" "SetConsoleMode"
  
public
  constant os_ENABLE_LINE_INPUT    0002h
  constant os_ENABLE_ECHO_INPUT    0004h

export os_SetConsoleMode os_GetConsoleMode


public
  constant os_MAX_PATH 260
  constant os_FILE_ATTRIBUTE_DIRECTORY 00000010h
  constant os_INVALID_HANDLE_VALUE -1

public

  type os_FILETIME
    packed
    field uInt dwLowDateTime dwHighDateTime

  type os_FIND_DATA
    packed
    field uInt dwFileAttributes
    field os_FILETIME ftCreationTime
    field os_FILETIME ftLastAccessTime
    field os_FILETIME ftLastWriteTime
    field uInt nFileSizeHigh
    field uInt nFileSizeLow
    field Int dwReserved0
    field Int dwReserved1
    field (Array Char os_MAX_PATH) cFileName
    field (Array Char 16) cAlternateFileName

function os_FindFirstFile name data -> handle
  arg CStr name ; arg_w os_FIND_DATA data ; arg Int handle
  external "kernel32.dll" "FindFirstFileA"
  
function os_FindNextFile handle data -> ok
  arg Int handle ; arg_w os_FIND_DATA data ; arg CBool ok
  external "kernel32.dll" "FindNextFileA"
  
function os_FindClose handle -> ok
  arg Int handle ; arg CBool ok
  external "kernel32.dll" "FindClose"

export os_FindFirstFile os_FindNextFile os_FindClose

public
  type os_EXCEPTION_RECORD
    packed
    field Int ExceptionCode
    field Int ExceptionFlags
    field Address ExceptionRecord
    field Address ExceptionAddress
    field Int NumberParameters
    field (Array Int 15) ExceptionInformation
  if processor_name="i386"
    type os_FLOATING_SAVE_AREA
      packed
      field Int ControlWord StatusWord TagWord
      field Int ErrorOffset ErrorSelector
      field Int DataOffset DataSelector
      field (Array Byte 80) RegisterArea
      field Int Cr0NpxState
    type os_CONTEXT 
      packed
      field Int ContextFlags
      field Int Dr0 Dr1 Dr2 Dr3 Dr6 Dr7
      field os_FLOATING_SAVE_AREA FloatSave
      field Int SegGs SegFs SegEs SegDs
      field Int Edi Esi Ebx Edx Ecx Eax
      field Int Ebp Eip SegCs EFlags Esp SegSs
  type os_EXCEPTION_POINTERS
    packed
    field Pointer:os_EXCEPTION_RECORD ExceptionRecord
    field Pointer:os_CONTEXT ContextRecord

public
  constant os_EXCEPTION_EXECUTE_HANDLER     1
  constant os_EXCEPTION_CONTINUE_SEARCH     0
  constant os_EXCEPTION_CONTINUE_EXECUTION -1

function os_SetUnhandledExceptionFilter f
  arg Address f
  external "kernel32.dll" "SetUnhandledExceptionFilter"

public
  constant os_SEM_FAILCRITICALERRORS          0001h
  constant os_SEM_NOGPFAULTERRORBOX           0002h
  constant os_SEM_SEM_NOALIGNMENTFAULTEXCEPT  0004h
  constant os_SEM_NOOPENFILEERRORBOX          8000h

function os_SetErrorMode mode
  arg Int mode
  external "kernel32.dll" "SetErrorMode"

function os_SetConsoleCtrlHandler exec add -> ok
  arg Address exec ; arg CBool add ok
  external "kernel32.dll" "SetConsoleCtrlHandler"

constant CONTEXT_i386 10000h
public
  constant CONTEXT_CONTROL (CONTEXT_i386 .or. 1)
  constant CONTEXT_INTEGER (CONTEXT_i386 .or. 2)


function os_GetThreadContext handle c -> ok
  arg Int handle ; arg_rw os_CONTEXT c ; arg CBool ok
  external "kernel32.dll" "GetThreadContext"
  
export os_SetUnhandledExceptionFilter os_SetErrorMode os_SetConsoleCtrlHandler os_GetThreadContext


public
  type os_MEMORYSTATUS
    packed
    field uInt dwLength <- 32   #   
    field uInt dwMemoryLoad     #   MemoryLoad contains percentage memory used
    field uInt dwTotalPhys      #   TotalPhys contains total amount of physical memory in bytes
    field uInt dwAvailPhys      #   AvailPhys contains available physical memory
    field uInt dwTotalPageFile  #   TotalPageFile contains total amount of memory in the page file
    field uInt dwAvailPageFile  #   AvailPageFile contains available amount of memory in the page file
    field uInt dwTotalVirtual   #   TotalVirtual contains total amount of virtual memory
    field uInt dwAvailVirtual   #   AvailVirtual contains available virtual memory

function os_GlobalMemoryStatus ms
  arg_rw os_MEMORYSTATUS ms
  external "kernel32.dll" "GlobalMemoryStatus"

export os_GlobalMemoryStatus

function os_GetLastError -> err
  arg uInt err
  external "kernel32.dll" "GetLastError" 

export os_GetLastError

public
  type os_PROCESS_INFORMATION
    packed
    field uInt hProcess
    field uInt hThread
    field uInt dwProcessId
    field uInt dwThreadId 

  type os_STARTUPINFO
    packed
    field uInt cb <- 68
    field Address Reserved <- null
    field Address Desktop <- null
    field Address Title <- null
    field uInt X <- 0
    field uInt Y <- 0
    field uInt XSize <- 0
    field uInt YSize <- 0
    field uInt XCountChars <- 0
    field uInt YCountChars <- 0
    field uInt FillAttribute <- 0
    field uInt Flags <- 0
    field Int16 ShowWindow <- 1
    field Int16 cbReserved2 <- 0
    field uInt lpReserved2 <- 0
    field uInt StdInput StdOutput StdError   

  type os_SECURITY_ATTRIBUTES
    packed
    field uInt nLength <- 12
    field Address lpSecurityDescriptor
    field CBool bInheritHandle

  if false
   # Constants for the Creation Flags
   constant os_CREATE_BREAKAWAY_FROM_JOB            # The child processes of a process associated with a job are not associated with the job. 
   constant os_CREATE_DEFAULT_ERROR_MODE  04000000h # The new process does not inherit the error mode of the calling process.
   constant os_CREATE_FORCEDOS            00002000h # the system will force the application to run as an MS-DOS-based application rather than as an OS/2-based application.
   constant os_CREATE_NEW_CONSOLE         00000010h # The new process has a new console, instead of inheriting the parent's console.
   constant os_CREATE_NEW_PROCESS_GROUP   00000200h # The new process is the root process of a new process group.
   constant os_CREATE_NO_WINDOW           08000000h # If set, the console application is run without a console window.
   constant os_CREATE_SEPARATE_WOW_VDM    00000800h # If set, the new process runs in a private Virtual DOS Machine (VDM).
   constant os_CREATE_SHARED_WOW_VDM      00001000h # Run the new process in the shared Virtual DOS Machine.
   constant os_CREATE_SUSPENDED           00000004h # The primary thread of the new process is created in a suspended state.
   constant os_CREATE_UNICODE_ENVIRONMENT 00000400h # Indicates the format of the environ parameter.
   constant os_DEBUG_PROCESS              00000001h # The calling process is treated as a debugger, and the new process is debugged.
   constant os_DEBUG_ONLY_THIS_PROCESS    00000002h # If the calling process is being debugged, the new process becomes another process being debugged by the calling process's debugger.
   constant os_DETACHED_PROCESS           00000008h # The new process does not have access to the console of the parent process.

   # priority

   constant os_ABOVE_NORMAL_PRIORITY_CLASS           # > NORMAL_PRIORITY_CLASS but < HIGH_PRIORITY_CLASS.
   constant os_BELOW_NORMAL_PRIORITY_CLASS           # > IDLE_PRIORITY_CLASS but < NORMAL_PRIORITY_CLASS.
   constant os_HIGH_PRIORITY_CLASS         00000080h # Indicates a process that performs time-critical tasks.
   constant os_IDLE_PRIORITY_CLASS         00000040h # Indicates a process whose threads run only when the system is idle.
   constant os_NORMAL_PRIORITY_CLASS       00000020h # Indicates a normal process with no special scheduling needs.
   constant os_REALTIME_PRIORITY_CLASS     00000100h # Indicates a process that has the highest possible priority.

function os_CreateProcess name cmd patt tatt inherit createflags environ dir startupinfo pinfo -> ok
   arg CStr name # string that specifies the module to execute.
   arg CStr cmd # string that specifies the command line to execute.
   arg os_SECURITY_ATTRIBUTES patt # whether the process handle can be inherited. null -> cannot.
   arg os_SECURITY_ATTRIBUTES tatt # whether the thread handle can be inherited. null -> cannot.
   arg CBool inherit # whether the new process inherits handles from the calling process. 
   arg uInt createflags # additional flags that control the priority class and the creation of the process.
   arg Address environ # environment block for the new process. null -> environment of the calling process. 
   arg CStr dir # string that specifies the current drive and directory for the child process.
   arg os_STARTUPINFO startupinfo # how the main window for the new process should appear.
   arg_w os_PROCESS_INFORMATION pinfo # receives identification information about the new process.
   arg CBool ok # success; if fails you should call os_GetLastError for info
   external "kernel32.dll" "CreateProcessA"
 
function os_WaitForSingleObject handle time -> ret
   arg uInt handle # handle to object
   arg Int time ret # time-out interval (-1 is infinite wait)
   external "kernel32.dll" "WaitForSingleObject"

export os_CreateProcess os_WaitForSingleObject

public
  constant os_zlib_filename pliant_root_path+"binary\zlib.dll"