objinc.inc 6.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205
  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 Atari TOS
  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. {--------------------------------------------------------------------}
  15. { LEFT TO DO: }
  16. {--------------------------------------------------------------------}
  17. { o Implement SetfileSize }
  18. {--------------------------------------------------------------------}
  19. {---------------------------------------------------------------------------}
  20. { FileClose -> Platforms Atari TOS - Not checked }
  21. {---------------------------------------------------------------------------}
  22. FUNCTION FileClose(Handle: THandle): word;
  23. begin
  24. asm
  25. movem.l d2/d3/a2/a3,-(sp)
  26. move.w Handle,d0
  27. move.w d0,-(sp)
  28. move.w #$3e,-(sp)
  29. trap #1
  30. add.l #4,sp { restore stack ... }
  31. movem.l (sp)+,d2/d3/a2/a3
  32. end;
  33. FileClose := 0;
  34. end;
  35. {---------------------------------------------------------------------------}
  36. { FileOpen -> Platforms Atari TOS - 08Jul98 CEC }
  37. { Returns 0 on failure }
  38. {---------------------------------------------------------------------------}
  39. FUNCTION FileOpen (Var FileName: AsciiZ; Mode: Word): THandle;
  40. var
  41. oflags : longint;
  42. AHandle : THandle;
  43. begin
  44. AHandle:=0;
  45. { On opening reset error code }
  46. DosStreamError := 0;
  47. if Mode=stCreate then
  48. oflags:=4
  49. else
  50. { read/write access on existing file }
  51. oflags := Mode and 3;
  52. asm
  53. movem.l d2/d3/a2/a3,-(sp) { save used registers }
  54. cmp.l #4,oflags { check if rewrite mode ... }
  55. bne @opencont2
  56. { rewrite mode - create new file }
  57. move.w #0,-(sp)
  58. move.l FileName,-(sp)
  59. move.w #$3c,-(sp)
  60. trap #1
  61. add.l #8,sp { restore stack of os call }
  62. bra @end
  63. { reset - open existing files }
  64. @opencont2:
  65. move.w oflags,d0 { use flag as source ... }
  66. @opencont1:
  67. move.w d0,-(sp)
  68. move.l FileName,-(sp)
  69. move.w #$3d,-(sp)
  70. trap #1
  71. add.l #8,sp { restore stack of os call }
  72. @end:
  73. movem.l (sp)+,d2/d3/a2/a3
  74. tst.w d0
  75. bpl @opennoerr { if positive return values then ok }
  76. cmp.w #-1,d0 { if handle is -1 CON: }
  77. beq @opennoerr
  78. cmp.w #-2,d0 { if handle is -2 AUX: }
  79. beq @opennoerr
  80. cmp.w #-3,d0 { if handle is -3 PRN: }
  81. beq @opennoerr
  82. move.w d0,dosStreamError { otherwise normal error }
  83. @opennoerr:
  84. move.w d0,AHandle { get handle as SIGNED VALUE... }
  85. end;
  86. FileOpen := AHandle;
  87. end;
  88. {***************************************************************************}
  89. { DosSetFilePtr -> Platforms Atari TOS - 08Jul98 CEC }
  90. {***************************************************************************}
  91. FUNCTION SetFilePos (Handle: THandle; Pos: LongInt; MoveType: Word;
  92. Var Actual: LongInt): Word;
  93. BEGIN
  94. asm
  95. move.l d2,d6 { save d2 }
  96. movem.l d3/a2/a3,-(sp)
  97. move.w MoveType,-(sp) { seek from start of file }
  98. move.w Handle,-(sp)
  99. move.l pos,-(sp)
  100. move.w #$42,-(sp)
  101. trap #1
  102. lea 10(sp),sp
  103. move.l d6,d2 { restore d2 }
  104. movem.l (sp)+,d3/a2/a3
  105. move.l Actual,a0
  106. move.l d0,(a0)
  107. end;
  108. SetFilePos := DosStreamError; { Return any error }
  109. END;
  110. {---------------------------------------------------------------------------}
  111. { FileRead -> Platforms Atari TOS - 08Jul98 CEC }
  112. {---------------------------------------------------------------------------}
  113. FUNCTION FileRead (Handle: THandle; Var Buf; Count: Sw_Word;
  114. Var Actual: Sw_Word): Word;
  115. BEGIN
  116. asm
  117. move.l d2,d6 { save d2 }
  118. movem.l d3/a2/a3,-(sp)
  119. move.l buf,-(sp)
  120. move.l Count,-(sp)
  121. move.w Handle,d0
  122. move.w d0,-(sp)
  123. move.w #$3f,-(sp)
  124. trap #1
  125. lea 12(sp),sp
  126. move.l d6,d2 { restore d2 }
  127. movem.l (sp)+,d3/a2/a3
  128. tst.l d0
  129. bpl @dosrdend
  130. move.w d0,DosStreamError { error ... }
  131. @dosrdend:
  132. end;
  133. FileRead:=DosStreamError;
  134. Actual:=Count;
  135. end;
  136. {---------------------------------------------------------------------------}
  137. { FileWrite -> Platforms Atari TOS - 08Jul98 CEC }
  138. {---------------------------------------------------------------------------}
  139. FUNCTION FileWrite (Handle: THandle; Var Buf; Count: Sw_Word; Var Actual: Sw_Word): Word;
  140. BEGIN
  141. asm
  142. move.l d2,d6 { save d2 }
  143. movem.l d3/a2/a3,-(sp)
  144. move.l buf,-(sp)
  145. move.l Count,-(sp)
  146. move.w Handle,d0
  147. move.w d0,-(sp)
  148. move.w #$40,-(sp)
  149. trap #1
  150. lea 12(sp),sp
  151. move.l d6,d2 { restore d2 }
  152. movem.l (sp)+,d3/a2/a3
  153. tst.l d0
  154. bpl @doswrend
  155. move.w d0,DosStreamError { error ... }
  156. @doswrend:
  157. end;
  158. Actual:=Count;
  159. FileWrite:=DosStreamError;
  160. end;
  161. {---------------------------------------------------------------------------}
  162. { SetFileSize -> Platforms Atari TOS - 08Jul98 CEC }
  163. {---------------------------------------------------------------------------}
  164. FUNCTION SetFileSize (Handle: THandle; FileSize: LongInt): Word;
  165. VAR Actual, Buf: LongInt;
  166. BEGIN
  167. SetFilePos(Handle,FileSize,0,Actual);
  168. If (Actual = FileSize) Then
  169. Begin
  170. Actual := FileWrite(Handle, Pointer(@Buf), 0,Actual); { Truncate the file }
  171. If (Actual <> -1) Then
  172. SetFileSize := 0
  173. Else
  174. SetFileSize := 103; { File truncate error }
  175. End
  176. Else
  177. SetFileSize := 103; { File truncate error }
  178. END;
  179. {
  180. $Log$
  181. Revision 1.2 2000-07-13 11:33:37 michael
  182. + removed logs
  183. }