123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313 |
- {
- This file is part of the Free Pascal run time library.
- Main OS dependant body of the system unit, loosely modelled
- after POSIX. *BSD version (Linux version is near identical)
- See the file COPYING.FPC, included in this distribution,
- for details about the copyright.
- 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.
- **********************************************************************}
- procedure Do_Close(Handle:thandle);
- var
- res: __wasi_errno_t;
- begin
- repeat
- res:=__wasi_fd_close(Handle);
- until (res=__WASI_ERRNO_SUCCESS) or (res<>__WASI_ERRNO_INTR);
- if res=__WASI_ERRNO_SUCCESS then
- InOutRes:=0
- else
- InOutRes:=Errno2InoutRes(res);
- end;
- procedure Do_Erase(p: PAnsiChar; pchangeable: boolean);
- var
- fd: __wasi_fd_t;
- pr: RawByteString;
- res: __wasi_errno_t;
- begin
- InOutRes:=ConvertToFdRelativePath(p,fd,pr);
- if InOutRes<>0 then
- exit;
- res:=__wasi_path_unlink_file(fd,PAnsiChar(pr),Length(pr));
- if res<>__WASI_ERRNO_SUCCESS then
- InOutRes:=Errno2InoutRes(res);
- end;
- procedure do_truncate (handle:thandle;fpos:int64);
- var
- res: __wasi_errno_t;
- begin
- res:=__wasi_fd_filestat_set_size(handle,fpos);
- if res=__WASI_ERRNO_SUCCESS then
- InOutRes:=0
- else
- InOutRes:=Errno2InoutRes(res);
- end;
- procedure Do_Rename(p1,p2:PAnsiChar; p1changeable, p2changeable: boolean);
- var
- fd1,fd2: __wasi_fd_t;
- pr1,pr2: RawByteString;
- res: __wasi_errno_t;
- begin
- InOutRes:=ConvertToFdRelativePath(p1,fd1,pr1);
- if InOutRes<>0 then
- exit;
- InOutRes:=ConvertToFdRelativePath(p2,fd2,pr2);
- if InOutRes<>0 then
- exit;
- res:=__wasi_path_rename(fd1,PAnsiChar(pr1),Length(pr1),fd2,PAnsiChar(pr2),Length(pr2));
- if res<>__WASI_ERRNO_SUCCESS then
- InOutRes:=Errno2InoutRes(res);
- end;
- function Do_Write(Handle:thandle;Addr:Pointer;Len:Longint):longint;
- var
- our_iov: __wasi_ciovec_t;
- our_nwritten: longint;
- res: __wasi_errno_t;
- begin
- repeat
- our_iov.buf := Addr;
- our_iov.buf_len := Len;
- res:=__wasi_fd_write(Handle, @our_iov, 1, @our_nwritten);
- until (res=__WASI_ERRNO_SUCCESS) or ((res<>__WASI_ERRNO_INTR) and (res<>__WASI_ERRNO_AGAIN));
- if res=__WASI_ERRNO_SUCCESS then
- begin
- Do_Write:=our_nwritten;
- InOutRes:=0;
- end
- else
- begin
- Do_Write:=0;
- InOutRes:=Errno2InoutRes(res);
- end;
- end;
- function Do_Read(Handle:thandle;Addr:Pointer;Len:Longint):Longint;
- var
- our_iov: __wasi_iovec_t;
- our_nread: __wasi_size_t;
- res: __wasi_errno_t;
- begin
- repeat
- our_iov.buf:=Addr;
- our_iov.buf_len:=Len;
- res:=__wasi_fd_read(Handle,@our_iov,1,@our_nread);
- until (res=__WASI_ERRNO_SUCCESS) or ((res<>__WASI_ERRNO_INTR) and (res<>__WASI_ERRNO_AGAIN));
- if res=__WASI_ERRNO_SUCCESS then
- begin
- Do_Read:=our_nread;
- InOutRes:=0;
- end
- else
- begin
- Do_Read:=0;
- InOutRes:=Errno2InoutRes(res);
- end;
- end;
- function Do_FilePos(Handle: thandle):Int64;
- var
- res: __wasi_errno_t;
- fpos:__wasi_filesize_t;
- begin
- res:=__wasi_fd_tell(Handle,@fpos);
- if res=__WASI_ERRNO_SUCCESS then
- begin
- InOutRes:=0;
- Do_FilePos:=fpos;
- end
- else
- begin
- InOutRes:=Errno2InoutRes(res);
- Do_FilePos:=-1;
- end;
- end;
- procedure Do_Seek(Handle:thandle;Pos:Int64);
- var
- res: __wasi_errno_t;
- newoffset: __wasi_filesize_t;
- begin
- res:=__wasi_fd_seek(Handle,Pos,__WASI_WHENCE_SET,@newoffset);
- if res=__WASI_ERRNO_SUCCESS then
- InOutRes:=0
- else
- InOutRes:=Errno2InoutRes(res);
- end;
- function Do_Seekend(Handle:thandle):Int64;
- var
- res: __wasi_errno_t;
- newoffset: __wasi_filesize_t;
- begin
- res:=__wasi_fd_seek(Handle,0,__WASI_WHENCE_END,@newoffset);
- if res=__WASI_ERRNO_SUCCESS then
- begin
- InOutRes:=0;
- Do_Seekend:=newoffset;
- end
- else
- begin
- InOutRes:=Errno2InoutRes(res);
- Do_Seekend:=-1;
- end;
- end;
- function Do_FileSize(Handle:thandle):Int64;
- var
- res: __wasi_errno_t;
- buf: __wasi_filestat_t;
- begin
- res:=__wasi_fd_filestat_get(Handle, @buf);
- if res=__WASI_ERRNO_SUCCESS then
- begin
- InOutRes:=0;
- Do_FileSize:=buf.size;
- end
- else
- begin
- InOutRes:=Errno2InoutRes(res);
- Do_FileSize:=0;
- end;
- end;
- procedure Do_Open(var f; p: PAnsiChar; flags: longint; pchangeable: boolean);
- {
- FileRec and textrec have both Handle and mode as the first items so
- they could use the same routine for opening/creating.
- when (flags and $100) the file will be append
- when (flags and $1000) the file will be truncate/rewritten
- when (flags and $10000) there is no check for close (needed for textfiles)
- }
- var
- oflags : __wasi_oflags_t = 0;
- fs_rights_base: __wasi_rights_t = 0;
- fdflags: __wasi_fdflags_t = 0;
- ourfd: __wasi_fd_t;
- res: __wasi_errno_t;
- pr: RawByteString;
- fd: __wasi_fd_t;
- Begin
- { close first if opened }
- if ((flags and $10000)=0) then
- begin
- case FileRec(f).mode of
- fminput,fmoutput,fminout : Do_Close(FileRec(f).Handle);
- fmclosed : ;
- else
- begin
- inoutres:=102; {not assigned}
- exit;
- end;
- end;
- end;
- { reset file Handle }
- FileRec(f).Handle:=UnusedHandle;
- { We do the conversion of filemodes here, concentrated on 1 place }
- case (flags and 3) of
- 0 : begin
- fs_rights_base :=__WASI_RIGHTS_FD_READ or
- __WASI_RIGHTS_FD_FILESTAT_GET or
- __WASI_RIGHTS_FD_SEEK or
- __WASI_RIGHTS_FD_TELL or
- __WASI_RIGHTS_FD_FDSTAT_SET_FLAGS or
- __WASI_RIGHTS_FD_ADVISE or
- __WASI_RIGHTS_POLL_FD_READWRITE;
- FileRec(f).mode:=fminput;
- end;
- 1 : begin
- fs_rights_base :=__WASI_RIGHTS_FD_WRITE or
- __WASI_RIGHTS_FD_FILESTAT_GET or
- __WASI_RIGHTS_FD_SEEK or
- __WASI_RIGHTS_FD_TELL or
- __WASI_RIGHTS_FD_FDSTAT_SET_FLAGS or
- __WASI_RIGHTS_FD_ADVISE or
- __WASI_RIGHTS_POLL_FD_READWRITE or
- __WASI_RIGHTS_FD_FILESTAT_SET_SIZE or
- __WASI_RIGHTS_FD_FILESTAT_SET_TIMES or
- __WASI_RIGHTS_FD_ALLOCATE or
- __WASI_RIGHTS_FD_DATASYNC or
- __WASI_RIGHTS_FD_SYNC;
- FileRec(f).mode:=fmoutput;
- end;
- 2 : begin
- fs_rights_base :=__WASI_RIGHTS_FD_READ or
- __WASI_RIGHTS_FD_WRITE or
- __WASI_RIGHTS_FD_FILESTAT_GET or
- __WASI_RIGHTS_FD_SEEK or
- __WASI_RIGHTS_FD_TELL or
- __WASI_RIGHTS_FD_FDSTAT_SET_FLAGS or
- __WASI_RIGHTS_FD_ADVISE or
- __WASI_RIGHTS_POLL_FD_READWRITE or
- __WASI_RIGHTS_FD_FILESTAT_SET_SIZE or
- __WASI_RIGHTS_FD_FILESTAT_SET_TIMES or
- __WASI_RIGHTS_FD_ALLOCATE or
- __WASI_RIGHTS_FD_DATASYNC or
- __WASI_RIGHTS_FD_SYNC;
- FileRec(f).mode:=fminout;
- end;
- end;
- if (flags and $1000)=$1000 then
- oflags:=oflags or (__WASI_OFLAGS_CREAT or __WASI_OFLAGS_TRUNC)
- else
- if (flags and $100)=$100 then
- fdflags:=fdflags or __WASI_FDFLAGS_APPEND;
- { empty name is special }
- if p[0]=#0 then
- begin
- case FileRec(f).mode of
- fminput :
- FileRec(f).Handle:=StdInputHandle;
- fminout, { this is set by rewrite }
- fmoutput :
- FileRec(f).Handle:=StdOutputHandle;
- fmappend :
- begin
- FileRec(f).Handle:=StdOutputHandle;
- FileRec(f).mode:=fmoutput; {fool fmappend}
- end;
- end;
- exit;
- end;
- InOutRes:=ConvertToFdRelativePath(p,fd,pr);
- if InOutRes<>0 then
- exit;
- { real open call }
- repeat
- res:=__wasi_path_open(fd,
- 0,
- PAnsiChar(pr),
- length(pr),
- oflags,
- fs_rights_base,
- fs_rights_base,
- fdflags,
- @ourfd);
- until (res=__WASI_ERRNO_SUCCESS) or (res<>__WASI_ERRNO_INTR);
- {if (res=__WASI_ERRNO_ROFS) and ((OFlags and O_RDWR)<>0) then
- begin
- Oflags:=Oflags and not(O_RDWR);
- repeat
- FileRec(f).Handle:=Fpopen(p,oflags,MODE_OPEN);
- until (FileRec(f).Handle<>-1) or (geterrno<>ESysEINTR);
- end;}
- If res<>__WASI_ERRNO_SUCCESS Then
- begin
- FileRec(f).mode:=fmclosed;
- InOutRes:=Errno2InoutRes(res);
- end
- else
- begin
- FileRec(f).Handle:=ourfd;
- InOutRes:=0;
- end;
- end;
|