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

if false

  function i386_fs_mov a b
    arg Int a ; arg_w Int b
  ((the_function i386_fs_mov Int Int) arg 1):access := ((the_function i386_fs_mov Int Int) arg 1):access .or. access_byvalue

  function generate_i386_fs_mov i f
    arg_rw Instruction i ; arg_rw Function f
    f code_immediat 01100100b 1 # fs
    if i:0:where=argument_register
      i386_regmem f 89h 1 i:0:register i:1
    eif i:1:where=argument_register
      i386_regmem f 8Bh 1 i:1:register i:0
    else
      error "i386 code generation: Invalid or arguments"
  (the_function i386_fs_mov Int Int) set_generate_binary (the_function generate_i386_fs_mov Instruction Function)


#----------------------------------------------------------------
#  processes and threads

if false

  function os_set_thread_data offset value
    arg Int offset value
    has_side_effects
  function assemble_os_set_thread_data i gc
    arg_rw Instruction i ; arg_rw GeneratorContext gc
    var Pointer:Instruction cur :> i
    var Link:Argument reg :> argument a_register
    var Link:Argument cell :> argument indirect Int i:0 0
    cur :> gc insert_after_instruction cur (instruction (the_function i386_mov Int Int) i:1 reg)
    cur :> gc insert_after_instruction cur (instruction (the_function i386_fs_mov Int Int) reg cell)
    gc remove i
  (the_function os_set_thread_data Int Int) set_generate_assembly (the_function assemble_os_set_thread_data Instruction GeneratorContext)

  function os_get_thread_data offset -> value
    arg Int offset value
    has_side_effects
  function assemble_os_get_thread_data i gc
    arg_rw Instruction i ; arg_rw GeneratorContext gc
    var Pointer:Instruction cur :> i
    var Link:Argument reg :> argument a_register
    var Link:Argument cell :> argument indirect Int i:0 0
    cur :> gc insert_after_instruction cur (instruction (the_function i386_fs_mov Int Int) cell reg)
    cur :> gc insert_after_instruction cur (instruction (the_function i386_mov Int Int) reg i:1)
    gc remove i
  (the_function os_get_thread_data Int -> Int) set_generate_assembly (the_function assemble_os_get_thread_data Instruction GeneratorContext)

  export os_set_thread_data os_get_thread_data


function os_DosCreateThread tid exe param flags stack_size -> err
  arg_w Int tid ; arg Address exe param ; arg Int flags stack_size err
  external "DOSCALL1.DLL" "311"

export os_DosCreateThread


public

  type os_RESULTCODES
    packed
    field Int codeTerminate
    field Int codeResult

  constant EXEC_SYNC 0
  constant EXEC_ASYNC 1

  function os_DosExecPgm buf size flags args env res progname -> err
    arg Address buf ; arg Int size flags err ; arg Address args env progname ; arg_rw os_RESULTCODES res
    external "DOSCALL1.DLL" "999"


#----------------------------------------------------------------
#  exceptions


public
  type os_TIB2
    packed
    field uInt tid
    field uInt priority
    field uInt version
    field uInt16 usMCCount
    field uInt16 fMCForceFlag
  type os_TIB
    packed
    field Address chain
    field Address stack_base
    field Address stack_limit
    field Pointer:os_TIB2 tib2
    field Int version
    field Int ordinal

  type os_PIB
    packed
    field Int pid
    field Int ppid
    field Int module_handle
    field Address command_line
    field Address environment
    field Int status
    field Int type

function os_DosGetInfoBlocks tib pib -> ret
  arg_rw Pointer:os_TIB tib ; arg_rw Pointer:os_PIB pib ; arg Int ret
  external "DOSCALL1.DLL" "312"

function os_DosAllocThreadLocalMemory cb ptr -> ret
  arg Int cb ; arg_w Address ptr ; arg Int ret
  external "DOSCALL1.DLL" "454"

function os_DosFreeThreadLocalMemory ptr -> ret
  arg Address ptr ; arg Int ret
  external "DOSCALL1.DLL" "455"

export os_DosGetInfoBlocks os_DosAllocThreadLocalMemory os_DosFreeThreadLocalMemory


type os_ExceptionReport
  packed
  field uInt16 num
  field uInt16 severity
  field Int flags
  field Address nested
  field Address address
  field Int extra_size
  field Int extra1 extra2 extra3 extra4

type os_ExceptionHandler
  packed
  field Address previous
  field Address executable

type os_FpReg
  packed
  field Int l h
  field uInt16 se

type os_ExceptionContext
  packed
  field Int context_flags
  field Int ctx0 ctx1 ctx2 ctx3 ctx4 ctx5 ctx6
  field os_FpReg fp0 fp1 fp2 fp3 fp4 fp5 fp6 fp7
  field Int gs fs es ds
  field Int edi esi eax ebx ecx edx
  field Int ebp eip cs flags esp ss

function os_DosSetExceptionHandler h -> ret
  arg_rw os_ExceptionHandler h ; arg Int ret
  external "DOSCALL1.DLL" "354"

function os_DosUnsetExceptionHandler h -> ret
  arg_rw os_ExceptionHandler h ; arg Int ret
  external "DOSCALL1.DLL" "355"

function os_DosError i -> ret
  arg Int i ret
  external "DOSCALL1.DLL" "212"

export os_ExceptionReport '. num' '. severity'
export os_ExceptionHandler '. previous' '. executable'
export os_FpReg
export os_ExceptionContext '. eip' '. ebp'
export os_DosSetExceptionHandler os_DosUnsetExceptionHandler os_DosError


constant ERROR_NOT_FROZEN 90

function os_DosSleep ms
  arg Int ms
  external "DOSCALL1.DLL" "229"

function os_DosSuspendThread tid -> ret
  arg Int tid ret
  external "DOSCALL1.DLL" "238"

function os_DosResumeThread tid -> ret
  arg Int tid ret
  external "DOSCALL1.DLL" "237"

constant EXIT_THREAD 0
constant EXIT_PROCESS 1

function os_DosExit action result
  arg Int action result
  external "DOSCALL1.DLL" "234"

public
  type os_DATETIME
    field uInt8 hours minutes seconds hundredths
    field uInt8 day month ; field uInt16 year
    field Int16 timezone ; field uInt8 weekday

function os_DosGetDateTime dt -> ret
  arg_w os_DATETIME dt ; arg Int ret
  external "DOSCALL1.DLL" "230"

export ERROR_NOT_FROZEN
export EXIT_THREAD
export EXIT_PROCESS
export os_DosSleep os_DosSuspendThread os_DosResumeThread os_DosExit os_DosGetDateTime


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

function os_DosOpen namez handle action cb attribute openflags openmode ea -> err
  arg CStr namez ; arg_rw Int handle action ; arg Int cb attribute openflags openmode ; arg Address ea ; arg Int err
  external "DOSCALL1.DLL" "273"

constant OPEN_ACTION_FAIL_IF_EXISTS    0000h
constant OPEN_ACTION_OPEN_IF_EXISTS    0001h
constant OPEN_ACTION_REPLACE_IF_EXISTS 0002h
constant OPEN_ACTION_FAIL_IF_NEW       0000h
constant OPEN_ACTION_CREATE_IF_NEW     0010h

constant FILE_NORMAL                   0000h

constant OPEN_ACCESS_READONLY          0000h
constant OPEN_ACCESS_WRITEONLY         0001h
constant OPEN_ACCESS_READWRITE         0002h
constant OPEN_SHARE_DENYREADWRITE      0010h
constant OPEN_SHARE_DENYWRITE          0020h
constant OPEN_SHARE_DENYREAD           0030h
constant OPEN_SHARE_DENYNONE           0040h
constant OPEN_FLAGS_SEQUENTIAL         0100h
constant OPEN_FLAGS_NO_CACHE           1000h

constant FILE_BEGIN 0
constant FILE_CURRENT 1
constant FILE_END 2

constant FILE_DIRECTORY 10h

constant FIL_STANDARD 1

constant ERROR_TOO_MANY_OPEN_FILES     4

function os_DosSetRelMaxFH count curmax
  arg_rw Int count curmax
  external "DOSCALL1.DLL" "382"

export os_DosOpen os_DosSetRelMaxFH
export OPEN_ACTION_FAIL_IF_EXISTS OPEN_ACTION_OPEN_IF_EXISTS OPEN_ACTION_REPLACE_IF_EXISTS
export OPEN_ACTION_FAIL_IF_NEW OPEN_ACTION_CREATE_IF_NEW
export FILE_NORMAL
export OPEN_ACCESS_READONLY OPEN_ACCESS_WRITEONLY OPEN_ACCESS_READWRITE
export OPEN_SHARE_DENYREADWRITE OPEN_SHARE_DENYWRITE OPEN_SHARE_DENYREAD OPEN_SHARE_DENYNONE
export OPEN_FLAGS_SEQUENTIAL OPEN_FLAGS_NO_CACHE
export FILE_BEGIN FILE_CURRENT FILE_END
export FILE_DIRECTORY
export FIL_STANDARD
export ERROR_TOO_MANY_OPEN_FILES

function os_DosRead handle buffer size red -> err
  arg Int handle ; arg Address buffer ; arg Int size ; arg_rw Int red ; arg Int err
  external "DOSCALL1.DLL" "281"

function os_DosWrite handle buffer size written -> err
  arg Int handle ; arg Address buffer ; arg Int size ; arg_rw Int written; arg Int err
  external "DOSCALL1.DLL" "282"

function os_DosResetBuffer handle -> err
  arg Int handle ; arg Int err
  external "DOSCALL1.DLL" "254"

function os_DosSetFilePtr handle offset method actual -> err
  arg Int handle offset method ; arg_w uInt actual ; arg Int err
  external "DOSCALL1.DLL" "256"

function os_DosShutdown reserved -> err
  arg Int reserved err
  external "DOSCALL1.DLL" "415"

function os_DosClose handle -> err
  arg Int handle err
  external "DOSCALL1.DLL" "257"

function os_DosCreateDir name attrib -> err
  arg CStr name ; arg Address attrib ; arg Int err
  external "DOSCALL1.DLL" "270"

function os_DosDeleteDir name -> err
  arg CStr name ; arg Int err
  external "DOSCALL1.DLL" "226"

function os_DosDelete name -> err
  arg CStr name ; arg Int err
  external "DOSCALL1.DLL" "259"

function os_DosFindFirst name handle attrib buf size count level -> err
  arg CStr name ; arg_rw Int handle ; arg Int attrib ; arg Address buf ; arg Int size ; arg_rw Int count ; arg Int level err
  external "DOSCALL1.DLL" "264"

function os_DosFindNext handle buf size count -> err
  arg Int handle ; arg Address buf ; arg Int size ; arg_w Int count ; arg Int err
  external "DOSCALL1.DLL" "265"

function os_DosFindClose handle -> err
  arg Int handle err
  external "DOSCALL1.DLL" "263"

public

  type FDATE
    field uInt16 encoded
  method d day -> i
    arg FDATE d ; arg Int i
    i := d:encoded%2^5
  method d month -> i
    arg FDATE d ; arg Int i
    i := (d:encoded\2^5)%2^4
  method d year -> i
    arg FDATE d ; arg Int i
    i := d:encoded\2^9

  type FTIME
    field uInt16 encoded
  method t twosecs -> i
    arg FTIME t ; arg Int i
    i := t:encoded%2^5
  method t minutes -> i
    arg FTIME t ; arg Int i
    i := (t:encoded\2^5)%2^6
  method t hours -> i
    arg FTIME t ; arg Int i
    i := t:encoded\2^11

  type FILEFINDBUF3
    field Int oNextEntryOffset
    field FDATE fdateCreation
    field FTIME ftimeCreation
    field FDATE fdateLastAccess
    field FTIME ftimeLastAccess
    field FDATE fdateLastWrite
    field FTIME ftimeLastWrite
    field uInt cbFile
    field uInt cbFileAlloc
    field uInt attrFile
    field uInt8 cchName
    field (Array Char 256) achName


export os_DosRead os_DosWrite os_DosResetBuffer os_DosShutdown os_DosSetFilePtr os_DosClose
export os_DosCreateDir os_DosDeleteDir os_DosDelete
export os_DosFindFirst os_DosFindNext os_DosFindClose


#----------------------------------------------------------------
#  extra functions

function os_getpid -> pid
  arg Int pid
  os_DosGetInfoBlocks (var Pointer:os_TIB tib) (var Pointer:os_PIB pib)
  pid := pib pid

function os_yield
  os_DosSleep 0

function os_exit retcode
  arg Int retcode
  os_DosExit EXIT_PROCESS retcode

export os_getpid os_yield os_exit