objinc.inc 3.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 1999-2000 by the Free Pascal development team.
  5. Includefile for objects.pp implementing OS-dependent file routines
  6. for EMX (OS/2 & DOS)
  7. See the file COPYING.FPC, included in this distribution,
  8. for details about the copyright.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  12. **********************************************************************
  13. }
  14. {This is the correct way to call external assembler procedures.}
  15. procedure syscall;external name '___SYSCALL';
  16. FUNCTION FileClose(Handle: THandle): word;
  17. begin
  18. asm
  19. xor %bx,%bx
  20. movw handle,%bx
  21. movb $0x3e,%ah
  22. call syscall
  23. end;
  24. FileClose := 0;
  25. end;
  26. procedure AllowSlash (P: PChar);
  27. {Allow slash as backslash.}
  28. var I: longint;
  29. begin
  30. for I := 0 to StrLen (P) do
  31. if P [I] = '/' then P [I] := '\';
  32. end;
  33. function FileOpen (var FileName: AsciiZ; Mode: word): THandle;
  34. var AMode: longint;
  35. begin
  36. if Mode = stCreate then
  37. AMode := $50000 (* Create / replace *)
  38. else
  39. AMode := Mode and $FF;
  40. (* DenyAll if sharing not specified. *)
  41. if AMode and 112 = 0 then AMode := AMode or 16;
  42. asm
  43. xorl %eax, %eax
  44. movw %ax, DosStreamError
  45. movl FileName, %edx
  46. movl $0x7f0b, %eax
  47. movl AMode, %ecx
  48. call syscall
  49. cmpl $0xffffffff, %eax
  50. jnz .Lexit1
  51. movw %cx, DosStreamError { Hold Error }
  52. xorl %eax, %eax { Open Failed }
  53. .Lexit1:
  54. movw %ax, __RESULT
  55. end;
  56. end;
  57. FUNCTION SetFilePos (Handle: THandle; Pos: LongInt; MoveType: Word;
  58. Var Actual: LongInt): Word;
  59. Var
  60. val : longint;
  61. BEGIN
  62. asm
  63. movw MoveType, %ax; { Load move type }
  64. movb $0x42, %ah;
  65. movl pos, %edx; { Load file position }
  66. movw Handle, %bx; { Load file handle }
  67. call syscall
  68. jc .Lexit4
  69. movl %eax,val { Update new position }
  70. xorl %eax, %eax;
  71. .Lexit4:
  72. movw %ax, DosStreamError { OS2 error returned }
  73. .Lend:
  74. END;
  75. Actual := val;
  76. SetFilePos := DosStreamError; { Return any error }
  77. END;
  78. FUNCTION FileRead (Handle: THandle; Var Buf; Count: Sw_Word;
  79. Var Actual: Sw_Word): Word;
  80. BEGIN
  81. asm
  82. movl count,%ecx
  83. movl buf,%edx
  84. xorl %ebx,%ebx
  85. movw handle,%bx
  86. movb $0x3f,%ah
  87. call syscall
  88. jnc .LDOSREAD1
  89. movw %ax,DosStreamError
  90. xorl %eax,%eax
  91. .LDOSREAD1:
  92. end;
  93. Actual:=Count;
  94. FileRead:=DosStreamError;
  95. end;
  96. FUNCTION FileWrite (Handle: THandle; Var Buf; Count: Sw_Word; Var Actual: Sw_Word): Word;
  97. BEGIN
  98. Actual:=0;
  99. asm
  100. movl Count,%ecx
  101. movl buf,%edx
  102. xorl %ebx,%ebx
  103. movw Handle,%bx
  104. movb $0x40,%ah
  105. call syscall
  106. jnc .LDOSWRITE1
  107. movw %ax,DosStreamError
  108. .LDOSWRITE1:
  109. end;
  110. Actual:=Count;
  111. FileWrite:=DosStreamError;
  112. end;
  113. function SetFileSize (Handle: THandle; FileSize: longint): word; assembler;
  114. asm
  115. movl $0x7F18, %eax
  116. movzwl Handle, %ebx
  117. movl FileSize,%edx
  118. call syscall
  119. jc .LSetFSize1
  120. movl $0x4202, %eax
  121. movzwl Handle, %ebx
  122. movl $0, %edx
  123. call syscall
  124. movl $0, %eax
  125. jnc .LSetFSize1
  126. decl %eax
  127. .LSetFSize1:
  128. end;
  129. {
  130. $Log$
  131. Revision 1.3 2000-09-29 21:49:41 jonas
  132. * removed warnings
  133. Revision 1.2 2000/07/13 11:33:52 michael
  134. + removed logs
  135. }