

      block data
        integer*4 arg_count
        common /arg_count_cb/ arg_count
        data arg_count /-1/
      end

      global define
       include "WINDEF.INC"
       include "WINNT.INC"
       include "WINBASE.INC"
       include "ERRNO.INC"
      end


      integer*4 function IARGC()
      implicit none 
      integer*4 arg_count
      common /arg_count_cb/ arg_count

      if (arg_count .EQ. -1) then
        call init_count()
      end if

      IARGC = arg_count
      END


      subroutine GETARG(k,arg)
      implicit none 
      character*(*) arg
      integer*4 k
      integer*4 arg_count
      integer*4 tmp_arg_count
      common /arg_count_cb/ arg_count
      integer*4 i,j 
      character*1 cmd_string(1)
      pointer(p_cmd_string,cmd_string)
      
      p_cmd_string = GetCommandLine()

      if (arg_count .EQ. -1) then
        call init_count()
      end if
     
      arg = ' ';
      if (k .GT. arg_count) return

      tmp_arg_count = -1
      i = 1
      do while (cmd_string(i) .NE. char(0))
        if ((cmd_string(i) .NE. ' ') .AND.
     &      (cmd_string(i) .NE. char(9))) then
          tmp_arg_count = tmp_arg_count + 1
          if (tmp_arg_count .EQ. k) then
	    j = 1
            do while ((cmd_string(i) .NE. ' ') .AND.
     &                (cmd_string(i) .NE. char(9)) .AND.
     &                (cmd_string(i) .NE. char(0)))
              arg(j:j) = cmd_string(i)
              i = i + 1
              j = j + 1
            end do
            return
          else 
            do while ((cmd_string(i) .NE. ' ') .AND.
     &                (cmd_string(i) .NE. char(9)) .AND.
     &                (cmd_string(i) .NE. char(0)))
              i = i + 1
            end do
          end if
        else
          i = i + 1
        end if
      end do
      end


      subroutine init_count()
      implicit none 
      integer*4 arg_count
      common /arg_count_cb/ arg_count
      integer*4 n 
      character*1 cmd_string(1) 
      pointer(p_cmd_string,cmd_string)
      
      p_cmd_string = GetCommandLine()
      n = 1
      do while (cmd_string(n) .NE. char(0)) 
        if ((cmd_string(n) .NE. ' ') .AND. 
     &      (cmd_string(n) .NE. char(9))) then
          arg_count = arg_count + 1
          do while ((cmd_string(n) .NE. ' ') .AND.
     &              (cmd_string(n) .NE. char(9)) .AND.
     &              (cmd_string(n) .NE. char(0))) 
            n = n + 1

          end do
        else
	  n = n + 1
        end if
      end do
      end
 
      subroutine EXIT(status)
      implicit none
      integer*4 status

      call close_all_units()
      call ExitProcess(VAL(status))
      end

      integer function ACCESS(name,mode)
      implicit none
      character*(*) name,mode
      integer*4 attr
    
      ! VAL(LOC inhibits pushing string length on the stack
      attr = GetFileAttributes(VAL(LOC(trim(name)//char(0))))
      if (attr .EQ. -1) then
        call set_errno(VAL(ENOENT)) 
        ACCESS = ENOENT 
      else
	ACCESS = 0  
	if (INDEX(mode,'w') .NE. 0) then  
          if (IAND(attr,FILE_ATTRIBUTE_READONLY) .NE. 0) then
	    call set_errno(VAL(EACCES)) 
            ACCESS = EACCES
          endif 
        endif
      endif
      end

      integer*4 function CHDIR(dirname)
      implicit none 
      character*(*) dirname
      integer*4 result
      ! VAL(LOC inhibits pushing string length on the stack
      result = SetCurrentDirectory(VAL(LOC(trim(dirname)//char(0))))
      if (result .EQ. 0) then
        call set_errno(VAL(ENOENT))
        CHDIR = ENOENT
      else
        CHDIR = 0
      endif
      end

      integer*4 function GETCWD(dirname)
      implicit none
      character*(*) dirname
      integer*4 result,n

      ! VAL(LOC inhibits pushing string length on the stack
      result = GetCurrentDirectory(VAL(LEN(dirname)),
     &  VAL(LOC(dirname)))
      if (result .EQ. 0) then
        call set_errno(VAL(ERANGE))
        GETCWD = ERANGE
      else
        GETCWD = 0
        do n = 1, len(dirname)
          if (dirname(n:n) .EQ. char(0)) then
            dirname(n:) = ' '
            return 
          end if
        end do
      end if
      end

      integer function RENAME(from,to)
      implicit none
      character*(*) from,to
      integer result
      external ACCESS
      integer ACCESS 
      external UNLINK
      integer UNLINK 

      result = ACCESS(to,'rw') 
      if (result .EQ. 0) then
        result = UNLINK(to)
        if (result .NE. 0) then
          RENAME = result
          return
        end if
      end if

      ! VAL(LOC inhibits pushing string length on the stack
      result = MoveFile(VAL(LOC(trim(from)//char(0))),
     &  VAL(LOC(trim(to)//char(0)))) 
      if (result .EQ. TRUE) then
        RENAME = 0 
      else if (ACCESS(from,'rw') .EQ. 0) then
        call set_errno(VAL(EACCES))
        RENAME = EACCES 
      else 
        call set_errno(VAL(ENOENT))
        RENAME = ENOENT
      end if
      end

      integer function SYSTEM(string)
      implicit none
      character*(*) string
      record/STARTUPINFO/si
      record/PROCESS_INFORMATION/pi
      integer iret
      integer dw
      integer dwExitCode

      dwExitCode  = -1

      si.cb = 68 ! sizeof(si)
      si.lpReserved = 0
      si.lpDesktop = 0
      si.lpTitle = 0
      si.dwFlags = 0
      si.cbReserved2 = 0
      si.lpReserved2 = 0

      ! VAL(LOC inhibits pushing string length on the stack
      iret = CreateProcess(
     &  VAL4(0),
     &  VAL(LOC(trim(string)//char(0))),
     &  VAL4(0),
     &  VAL4(0),
     &  VAL4(TRUE), 
     &  VAL4(NORMAL_PRIORITY_CLASS),
     &  VAL4(0),
     &  VAL4(0),
     &  si,
     &  pi)

      if (iret .NE. 0) then
        dw = WaitForSingleObject(VAL(pi.hProcess),VAL(INFINITE))
        if (dw .NE. -1) then
           call GetExitCodeProcess(VAL(pi.hProcess),dwExitCode)
        end if
        call CloseHandle(VAL(pi.hThread))
        call CloseHandle(VAL(pi.hProcess))
      end if
      SYSTEM = dwExitCode;
      end

      integer*4 function UNLINK(name)
      implicit none
      character*(*) name
      integer*4 result
      
      ! VAL(LOC inhibits pushing string length on the stack
      result = DeleteFile(VAL(LOC(trim(name)//char(0))))

      if (result .EQ. FALSE) then
        if (GetFileAttributes(
     &    VAL(LOC(trim(name)//char(0)))) .EQ. -1) then
          call set_errno(VAL(ENOENT))
          result = ENOENT
        else
          call set_errno(VAL(EACCES))
          result = EACCES
        end if
      else
        result = 0 
      end if

      UNLINK = result
      end
