text.inc 19 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872
  1. { $Id$
  2. This file is part of the Free Pascal Run time library.
  3. Copyright (c) 1993,97 by the Free Pascal development team
  4. See the file COPYING.FPC, included in this distribution,
  5. for details about the copyright.
  6. This program is distributed in the hope that it will be useful,
  7. but WITHOUT ANY WARRANTY; without even the implied warranty of
  8. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  9. **********************************************************************}
  10. {
  11. Possible Defines:
  12. EXTENDED_EOF Use extended EOF checking for textfile, necessary for
  13. Pipes and Sockets under Linux
  14. EOF_CTRLZ Is Ctrl-Z (#26) a EOF mark for textfiles
  15. SHORT_LINEBREAK Use short Linebreaks #10 instead of #10#13
  16. Both EXTENDED_EOF and SHORT_LINEBREAK are defined in the Linux system
  17. unit (syslinux.pp)
  18. }
  19. {****************************************************************************
  20. subroutines For TextFile handling
  21. ****************************************************************************}
  22. Procedure FileCloseFunc(Var t:TextRec);
  23. Begin
  24. Do_Close(t.Handle);
  25. t.Handle:=UnusedHandle;
  26. End;
  27. Procedure FileInOutFunc(var t:TextRec);
  28. Begin
  29. Case t.mode Of
  30. fmoutput : Do_Write(t.Handle,Longint(t.Bufptr),t.BufPos);
  31. fminput : t.BufEnd:=Do_Read(t.Handle,Longint(t.Bufptr),t.BufSize);
  32. else
  33. RunError(102);
  34. End;
  35. t.BufPos:=0;
  36. End;
  37. Procedure FileOpenFunc(var t:TextRec);
  38. var
  39. Flags : Longint;
  40. Begin
  41. t.InOutFunc:=@FileInOutFunc;
  42. t.FlushFunc:=@FileInOutFunc;
  43. t.CloseFunc:=@FileCloseFunc;
  44. Case t.mode Of
  45. fmInput : Flags:=$1000;
  46. fmOutput : Flags:=$1101;
  47. fmAppend : Flags:=$1011;
  48. End;
  49. Do_Open(t,PChar(@TextRec(t).Name),Flags);
  50. End;
  51. Procedure assign(var t:Text;const s:String);
  52. Begin
  53. FillChar(t,SizEof(TextRec),0);
  54. TextRec(t).Handle:=UnusedHandle;
  55. TextRec(t).mode:=fmClosed;
  56. TextRec(t).BufSize:=128;
  57. TextRec(t).Bufptr:=@TextRec(t).Buffer;
  58. TextRec(t).OpenFunc:=@FileOpenFunc;
  59. Move(s[1],TextRec(t).Name,Length(s));
  60. End;
  61. Procedure Close(var t : Text);[Public,Alias: 'CLOSE_TEXT',IOCheck];
  62. Begin
  63. If (TextRec(t).mode<>fmClosed) Then
  64. Begin
  65. FileFunc(TextRec(t).FlushFunc)(TextRec(t));
  66. TextRec(t).mode:=fmClosed;
  67. { Only close functions not connected to stdout.}
  68. If ((TextRec(t).Handle<>StdInputHandle) or
  69. (TextRec(t).Handle<>StdOutputHandle) or
  70. (TextRec(t).Handle<>StdErrorHandle)) Then
  71. FileFunc(TextRec(t).CloseFunc)(TextRec(t));
  72. End;
  73. End;
  74. Procedure OpenText(var t : Text;mode,defHdl:Longint);
  75. Begin
  76. Case TextRec(t).mode Of {This gives the fastest code}
  77. fmInput,fmOutput,fmInOut : Close(t);
  78. fmClosed : ;
  79. else
  80. Begin
  81. InOutRes:=102;
  82. exit;
  83. End;
  84. End;
  85. TextRec(t).mode:=mode;
  86. If TextRec(t).Name[0]<>#0 Then
  87. FileFunc(TextRec(t).OpenFunc)(TextRec(t))
  88. else
  89. Begin
  90. TextRec(t).Handle:=defHdl;
  91. TextRec(t).InOutFunc:=@FileInOutFunc;
  92. TextRec(t).FlushFunc:=@FileInOutFunc;
  93. TextRec(t).CloseFunc:=@FileCloseFunc;
  94. End;
  95. End;
  96. Procedure Rewrite(var t : Text);[IOCheck];
  97. Begin
  98. OpenText(t,fmOutput,1);
  99. End;
  100. Procedure Reset(var t : Text);[IOCheck];
  101. Begin
  102. OpenText(t,fmInput,0);
  103. End;
  104. Procedure Append(var t : Text);[IOCheck];
  105. Begin
  106. OpenText(t,fmAppend,1);
  107. End;
  108. Procedure Flush(var t : Text);[IOCheck];
  109. Begin
  110. If TextRec(t).mode<>fmOutput Then
  111. exit;
  112. FileFunc(TextRec(t).FlushFunc)(TextRec(t));
  113. End;
  114. Procedure Erase(var t:Text);[IOCheck];
  115. Begin
  116. If TextRec(t).mode=fmClosed Then
  117. Do_Erase(PChar(@TextRec(t).Name));
  118. End;
  119. Procedure Rename(var t:Text;const s:String);[IOCheck];
  120. var
  121. p : array[0..255] Of Char;
  122. Begin
  123. If TextRec(t).mode=fmClosed Then
  124. Begin
  125. Move(s[1],p,Length(s));
  126. p[Length(s)]:=#0;
  127. Do_Rename(PChar(@TextRec(t).Name),PChar(@p));
  128. Move(p,TextRec(t).Name,Length(s)+1);
  129. End;
  130. End;
  131. Function Eof(Var t: Text): Boolean;[IOCheck];
  132. Begin
  133. {$IFNDEF EXTENDED_EOF}
  134. {$IFDEF EOF_CTRLZ}
  135. Eof:=TextRec(t).Buffer[TextRec(t).BufPos]=#26;
  136. If Eof Then
  137. Exit;
  138. {$ENDIF EOL_CTRLZ}
  139. Eof:=(Do_FileSize(TextRec(t).Handle)<=Do_FilePos(TextRec(t).Handle));
  140. If Eof Then
  141. Eof:=TextRec(t).BufEnd <= TextRec(t).BufPos;
  142. {$ELSE EXTENDED_EOF}
  143. { The previous method will NOT work on stdin and pipes or sockets.
  144. So how to do it ?
  145. 1) Check if characters in buffer - Yes ? Eof=false;
  146. 2) Read buffer full. If 0 Chars Read : Eof !
  147. Michael.}
  148. If TextRec(T).mode=fmClosed Then { Sanity Check }
  149. Begin
  150. Eof:=True;
  151. Exit;
  152. End;
  153. If (TextRec(T).BufPos < TextRec(T).BufEnd) Then
  154. Begin
  155. Eof:=False;
  156. Exit
  157. End;
  158. TextRec(T).BufPos:=0;
  159. TextRec(T).BufEnd:=Do_Read(TextRec(T).Handle,Longint(TextRec(T).BufPtr),TextRec(T).BufSize);
  160. If TextRec(T).BufEnd<0 Then
  161. TextRec(T).BufEnd:=0;
  162. Eof:=(TextRec(T).BufEnd=0);
  163. {$ENDIF EXTENDED_EOF}
  164. End;
  165. Function Eof:Boolean;
  166. Begin
  167. Eof:=Eof(Input);
  168. End;
  169. Function SeekEof (Var F : Text) : Boolean;
  170. Var
  171. TR : ^TextRec;
  172. Temp : Longint;
  173. Begin
  174. TR:=@TextRec(f);
  175. If TR^.mode<>fmInput Then exit (true);
  176. SeekEof:=True;
  177. {No data in buffer ? Fill it }
  178. If TR^.BufPos>=TR^.BufEnd Then
  179. FileFunc(TR^.InOutFunc)(TR^);
  180. Temp:=TR^.BufPos;
  181. while (TR^.BufPos<TR^.BufEnd) Do
  182. Begin
  183. If (TR^.Bufptr^[Temp] In [#9,#10,#13,' ']) Then
  184. Inc(Temp)
  185. else
  186. Begin
  187. SeekEof:=False;
  188. TR^.BufPos:=Temp;
  189. exit;
  190. End;
  191. If Temp>=TR^.BufEnd Then
  192. Begin
  193. FileFunc(TR^.InOutFunc)(TR^);
  194. Temp:=TR^.BufPos+1;
  195. End;
  196. End;
  197. End;
  198. Function SeekEof : Boolean;
  199. Begin
  200. SeekEof:=SeekEof(Input);
  201. End;
  202. Function Eoln(var t:Text) : Boolean;
  203. Begin
  204. { maybe we need new data }
  205. If TextRec(t).BufPos>=TextRec(t).BufEnd Then
  206. FileFunc(TextRec(t).InOutFunc)(TextRec(t));
  207. Eoln:=Eof(t) or (TextRec(t).Bufptr^[TextRec(t).BufPos] In [#10,#13]);
  208. End;
  209. Function Eoln : Boolean;
  210. Begin
  211. Eoln:=Eoln(Input);
  212. End;
  213. Function SeekEoln (Var F : Text) : Boolean;
  214. Var
  215. TR : ^TextRec;
  216. Temp : Longint;
  217. Begin
  218. TR:=@TextRec(f);
  219. If TR^.mode<>fmInput Then
  220. exit (true);
  221. SeekEoln:=True;
  222. {No data in buffer ? Fill it }
  223. If TR^.BufPos>=TR^.BufEnd Then
  224. FileFunc(TR^.InOutFunc)(TR^);
  225. Temp:=TR^.BufPos;
  226. while (TR^.BufPos<TR^.BufEnd) Do
  227. Begin
  228. Case (TR^.Bufptr^[Temp]) Of
  229. #10 : Exit;
  230. #9,' ' : Inc(Temp)
  231. else
  232. Begin
  233. SeekEoln:=False;
  234. TR^.BufPos:=Temp;
  235. exit;
  236. End;
  237. End;
  238. If Temp>=TR^.BufEnd Then
  239. Begin
  240. FileFunc(TR^.InOutFunc)(TR^);
  241. Temp:=TR^.BufPos+1;
  242. End;
  243. End;
  244. End;
  245. Function SeekEoln : Boolean;
  246. Begin
  247. SeekEoln:=SeekEoln(Input);
  248. End;
  249. Procedure SetTextBuf(Var F : Text; Var Buf);[INTERNPROC: In_settextbuf_file_x];
  250. Procedure SetTextBuf(Var F : Text; Var Buf; Size : Word);
  251. Begin
  252. TextRec(f).BufPtr:=@Buf;
  253. TextRec(f).BufSize:=Size;
  254. TextRec(f).BufPos:=0;
  255. TextRec(f).BufEnd:=0;
  256. End;
  257. {*****************************************************************************
  258. Write(Ln)
  259. *****************************************************************************}
  260. Procedure w(Len : Longint;var f : TextRec;var s : String);[Public,Alias: 'WRITE_TEXT_STRING'];
  261. var
  262. hbytes,Pos,copybytes : Longint;
  263. hs : String;
  264. Begin
  265. If f.mode<>fmOutput Then
  266. exit;
  267. copybytes:=Length(s);
  268. If Len>copybytes Then
  269. Begin
  270. hs:=Space(Len-copybytes);
  271. w(0,f,hs);
  272. End;
  273. Pos:=1;
  274. hbytes:=f.BufSize-f.BufPos;
  275. { If no room in Buffer, do a flush. }
  276. If hbytes=0 Then
  277. FileFunc(f.FlushFunc)(f);
  278. while copybytes>hbytes Do
  279. Begin
  280. Move(s[Pos],f.Bufptr^[f.BufPos],hbytes);
  281. f.BufPos:=f.BufPos+hbytes;
  282. dec(copybytes,hbytes);
  283. Inc(Pos,hbytes);
  284. FileFunc(f.InOutFunc)(f);
  285. hbytes:=f.BufSize-f.BufPos;
  286. End;
  287. Move(s[Pos],f.Bufptr^[f.BufPos],copybytes);
  288. f.BufPos:=f.BufPos+copybytes;
  289. End;
  290. Procedure w(var t : TextRec);[Public,Alias: 'WRITELN_TEXT'];
  291. var
  292. hs : String;
  293. Begin
  294. {$IFDEF SHORT_LINEBREAK}
  295. hs:=#10;
  296. {$ELSE}
  297. hs:=#13#10;
  298. {$ENDIF}
  299. w(0,t,hs);
  300. End;
  301. Type
  302. array00 = array[0..0] Of Char;
  303. Procedure w(Len : Longint;var f : TextRec;const p : array00);[Public,Alias: 'WRITE_TEXT_PCHAR_AS_ARRAY'];
  304. var
  305. hbytes,Pos,copybytes : Longint;
  306. hs : String;
  307. Begin
  308. If f.mode<>fmOutput Then
  309. exit;
  310. copybytes:=StrLen(p);
  311. If Len>copybytes Then
  312. Begin
  313. hs:=Space(Len-copybytes);
  314. w(0,f,hs);
  315. End;
  316. Pos:=0;
  317. hbytes:=f.BufSize-f.BufPos;
  318. { If no room in buffer , do a flush. }
  319. If hbytes=0 Then
  320. FileFunc(f.FlushFunc)(f);
  321. while copybytes>hbytes Do
  322. Begin
  323. Move(p[Pos],f.Bufptr^[f.BufPos],hbytes);
  324. f.BufPos:=f.BufPos+hbytes;
  325. dec(copybytes,hbytes);
  326. Inc(Pos,hbytes);
  327. FileFunc(f.InOutFunc)(f);
  328. hbytes:=f.BufSize-f.BufPos;
  329. End;
  330. Move(p[Pos],f.Bufptr^[f.BufPos],copybytes);
  331. f.BufPos:=f.BufPos+copybytes;
  332. End;
  333. Procedure wa(Len : Longint;var f : TextRec;p : PChar);[Public,Alias: 'WRITE_TEXT_PCHAR_AS_POINTER'];
  334. Begin
  335. w(Len,f,p);
  336. End;
  337. Procedure w(Len : Longint;var t : TextRec;l : Longint);[Public,Alias: 'WRITE_TEXT_LONGINT'];
  338. var
  339. s : String;
  340. Begin
  341. Str(l,s);
  342. w(Len,t,s);
  343. End;
  344. {$ifdef i386}
  345. Procedure w(fixkomma,Len : Longint;var t : TextRec;r : real);[Public,Alias: 'WRITE_TEXT_REAL'];
  346. var
  347. s : String;
  348. Begin
  349. Str_real(Len,fixkomma,r,rt_s64real,s);
  350. w(Len,t,s);
  351. End;
  352. {$else}
  353. Procedure w(fixkomma,Len : Longint;var t : TextRec;r : real);[Public,Alias: 'WRITE_TEXT_REAL'];
  354. var
  355. s : String;
  356. Begin
  357. Str_real(Len,fixkomma,r,rt_s32real,s);
  358. w(Len,t,s);
  359. End;
  360. {$endif}
  361. {$IFDEF VER_ABOVE0_9_7}
  362. { Older versions of the compiler convert all floats to real }
  363. Procedure w(Len : Longint;var t : TextRec;l : cardinal);[Public,Alias: 'WRITE_TEXT_CARDINAL'];
  364. var
  365. s : String;
  366. Begin
  367. Str(L,s);
  368. w(Len,t,s);
  369. End;
  370. {$ifdef ieee_support}
  371. Procedure w(fixkomma,Len : Longint;var t : TextRec;r : single);[Public,Alias: 'WRITE_TEXT_SINGLE'];
  372. var
  373. s : String;
  374. Begin
  375. Str_real(Len,fixkomma,r,rt_s32real,s);
  376. w(Len,t,s);
  377. End;
  378. Procedure w(fixkomma,Len : Longint;var t : TextRec;r : extended);[Public,Alias: 'WRITE_TEXT_EXTENDED'];
  379. var
  380. s : String;
  381. Begin
  382. Str_real(Len,fixkomma,r,rt_s80real,s);
  383. w(Len,t,s);
  384. End;
  385. {$endif ieee_support}
  386. {$ifdef comp_support}
  387. Procedure w(fixkomma,Len : Longint;var t : TextRec;r : comp);[Public,Alias: 'WRITE_TEXT_COMP'];
  388. var
  389. s : String;
  390. Begin
  391. Str_real(Len,fixkomma,r,rt_s64bit,s);
  392. w(Len,t,s);
  393. End;
  394. {$endif comp_support}
  395. Procedure w(fixkomma,Len : Longint;var t : TextRec;r : fixed);[Public,Alias: 'WRITE_TEXT_FIXED'];
  396. var
  397. s : String;
  398. Begin
  399. Str_real(Len,fixkomma,r,rt_f32bit,s);
  400. w(Len,t,s);
  401. End;
  402. {$ENDIF VER_ABOVE0_9_7 }
  403. { Is called wc to avoid recursive calling. }
  404. Procedure wc(Len : Longint;var t : TextRec;b : Boolean);[Public,Alias: 'WRITE_TEXT_BOOLEAN'];
  405. const
  406. BoolString:array[0..1] Of String[5]=('False','True');
  407. Begin
  408. w(Len,t,String(BoolString[byte(b)]));
  409. End;
  410. Procedure wc(Len : Longint;var t : TextRec;c : Char);[Public,Alias: 'WRITE_TEXT_CHAR'];
  411. var
  412. hs : String;
  413. Begin
  414. If t.mode<>fmOutput Then
  415. exit;
  416. If Len>1 Then
  417. Begin
  418. hs:=Space(Len-1);
  419. w(0,t,hs);
  420. End;
  421. If t.BufPos+1>=t.BufSize Then
  422. FileFunc(t.FlushFunc)(t);
  423. t.Bufptr^[t.BufPos]:=c;
  424. Inc(t.BufPos);
  425. End;
  426. {*****************************************************************************
  427. Read(Ln)
  428. *****************************************************************************}
  429. Function OpenInput(var f:TextRec):boolean;
  430. begin
  431. If f.mode=fmInput Then
  432. begin
  433. { No characters in the buffer? Load them ! }
  434. If f.BufPos>=f.BufEnd Then
  435. FileFunc(f.InOutFunc)(f);
  436. OpenInput:=true;
  437. end
  438. else
  439. OpenInput:=false;
  440. end;
  441. Function NextChar(var f:TextRec;var s:string):Boolean;
  442. begin
  443. if f.BufPos<f.BufEnd then
  444. begin
  445. s:=s+f.BufPtr^[f.BufPos];
  446. Inc(f.BufPos);
  447. If f.BufPos>=f.BufEnd Then
  448. FileFunc(f.InOutFunc)(f);
  449. NextChar:=true;
  450. end
  451. else
  452. NextChar:=false;
  453. end;
  454. Function IgnoreSpaces(var f:TextRec):Boolean;
  455. {
  456. Removes all leading spaces,tab,eols from the input buffer, returns true if
  457. the buffer is empty
  458. }
  459. var
  460. s : string;
  461. begin
  462. s:='';
  463. IgnoreSpaces:=false;
  464. while f.Bufptr^[f.BufPos] in [#9,#10,#13,' '] do
  465. if not NextChar(f,s) then
  466. exit;
  467. IgnoreSpaces:=true;
  468. end;
  469. Function ReadSign(var f:TextRec;var s:string):Boolean;
  470. {
  471. Read + and - sign, return true if buffer is empty
  472. }
  473. begin
  474. ReadSign:=(not (f.Bufptr^[f.BufPos] in ['-','+'])) or NextChar(f,s);
  475. end;
  476. Function ReadBase(var f:TextRec;var s:string;var Base:longint):boolean;
  477. {
  478. Read the base $ For 16 and % For 2, if buffer is empty return true
  479. }
  480. begin
  481. case f.BufPtr^[f.BufPos] of
  482. '$' : Base:=16;
  483. '%' : Base:=2;
  484. else
  485. Base:=10;
  486. end;
  487. ReadBase:=(Base=10) or NextChar(f,s);
  488. end;
  489. Function ReadNumeric(var f:TextRec;var s:string;base:longint):Boolean;
  490. {
  491. Read numeric input, if buffer is empty then return True
  492. }
  493. var
  494. c : char;
  495. begin
  496. ReadNumeric:=false;
  497. c:=f.BufPtr^[f.BufPos];
  498. while ((base>=10) and (c in ['0'..'9'])) or
  499. ((base=16) and (c in ['A'..'F','a'..'f'])) or
  500. ((base=2) and (c in ['0'..'1'])) do
  501. begin
  502. if not NextChar(f,s) then
  503. exit;
  504. c:=f.BufPtr^[f.BufPos];
  505. end;
  506. ReadNumeric:=true;
  507. end;
  508. Procedure r(var f : TextRec);[Public,Alias: 'READLN_TEXT'];
  509. Begin
  510. if not OpenInput(f) then
  511. exit;
  512. while (f.BufPos<f.BufEnd) do
  513. begin
  514. inc(f.BufPos);
  515. if (f.BufPtr^[f.BufPos-1]=#10) then
  516. exit;
  517. If f.BufPos>=f.BufEnd Then
  518. FileFunc(f.InOutFunc)(f);
  519. end;
  520. End;
  521. Procedure r(var f : TextRec;var s : String);[Public,Alias: 'READ_TEXT_STRING'];
  522. var
  523. Temp,sPos : Word;
  524. Begin
  525. { Delete the string }
  526. s:='';
  527. if not OpenInput(f) then
  528. exit;
  529. Temp:=f.BufPos;
  530. sPos:=1;
  531. while (f.BufPos<f.BufEnd) and (f.Bufptr^[Temp]<>#10) Do
  532. Begin
  533. { search linefeed }
  534. while (f.Bufptr^[Temp]<>#10) and (Temp<f.BufEnd) Do
  535. Inc(Temp);
  536. { copy String. Take 255 char limit in account.}
  537. If sPos+Temp-f.BufPos<=255 Then
  538. Begin
  539. Move (f.Bufptr^[f.BufPos],s[sPos],Temp-f.BufPos);
  540. sPos:=sPos+Temp-f.BufPos;
  541. If s[sPos-1]=#13 Then
  542. dec(sPos);
  543. End
  544. else
  545. Begin
  546. If (sPos<=255) Then
  547. Move(f.Bufptr^[f.BufPos],s[sPos],256-sPos);
  548. sPos:=256
  549. End;
  550. { update f.BufPos }
  551. f.BufPos:=Temp;
  552. If Temp>=f.BufEnd Then
  553. Begin
  554. FileFunc(f.InOutFunc)(f);
  555. Temp:=f.BufPos;
  556. End
  557. End;
  558. s[0]:=chr(sPos-1);
  559. End;
  560. Procedure r(var f : TextRec;var c : Char);[Public,Alias: 'READ_TEXT_CHAR'];
  561. Begin
  562. c:=#0;
  563. if not OpenInput(f) then
  564. exit;
  565. If f.BufPos>=f.BufEnd Then
  566. c:=#26
  567. else
  568. c:=f.Bufptr^[f.BufPos];
  569. Inc(f.BufPos);
  570. End;
  571. Procedure r(var f : TextRec;var s : PChar);[Public,Alias:'READ_TEXT_PCHAR_AS_POINTER'];
  572. var
  573. p : PChar;
  574. Temp : byte;
  575. Begin
  576. { Delete the string }
  577. s^:=#0;
  578. p:=s;
  579. if not OpenInput(f) then
  580. exit;
  581. Temp:=f.BufPos;
  582. while (f.BufPos<f.BufEnd) and (f.Bufptr^[Temp]<>#10) Do
  583. Begin
  584. { search linefeed }
  585. while (f.Bufptr^[Temp]<>#10) and (Temp<f.BufEnd) Do
  586. inc(Temp);
  587. { copy string. }
  588. Move (f.Bufptr^[f.BufPos],p^,Temp-f.BufPos);
  589. Inc(Longint(p),Temp-f.BufPos);
  590. If p^=#13 Then
  591. dec(Longint(p));
  592. { update f.BufPos }
  593. f.BufPos:=Temp;
  594. If Temp>=f.BufEnd Then
  595. Begin
  596. FileFunc(f.InOutFunc)(f);
  597. Temp:=f.BufPos;
  598. End
  599. End;
  600. p^:=#0;
  601. End;
  602. Procedure r(var f : TextRec;var l : Longint);[Public,Alias: 'READ_TEXT_LONGINT'];
  603. var
  604. hs : String;
  605. code : Word;
  606. base : longint;
  607. Begin
  608. l:=0;
  609. hs:='';
  610. if not OpenInput(f) then
  611. exit;
  612. if IgnoreSpaces(f) and ReadSign(f,hs) and ReadBase(f,hs,Base) then
  613. ReadNumeric(f,hs,Base);
  614. Val(hs,l,code);
  615. If code<>0 Then
  616. RunError(106);
  617. End;
  618. Procedure r(var f : TextRec;var l : Integer);[Public,Alias: 'READ_TEXT_INTEGER'];
  619. var
  620. ll : Longint;
  621. Begin
  622. r(f,ll);
  623. l:=0;
  624. If (ll<-32768) or (ll>32767) Then
  625. RunError(106);
  626. l:=ll;
  627. End;
  628. Procedure r(var f : TextRec;var l : Word);[Public,Alias: 'READ_TEXT_WORD'];
  629. var
  630. ll : Longint;
  631. Begin
  632. r(f,ll);
  633. l:=0;
  634. If (ll<0) or (ll>$ffff) Then
  635. RunError(106);
  636. l:=ll;
  637. End;
  638. Procedure r(var f : TextRec;var l : byte);[Public,Alias: 'READ_TEXT_BYTE'];
  639. var
  640. ll : Longint;
  641. Begin
  642. r(f,ll);
  643. l:=0;
  644. If (ll<0) or (ll>255) Then
  645. RunError(106);
  646. l:=ll;
  647. End;
  648. Procedure r(var f : TextRec;var l : shortint);[Public,Alias: 'READ_TEXT_SHORTINT'];
  649. var
  650. ll : Longint;
  651. Begin
  652. r(f,ll);
  653. l:=0;
  654. If (ll<-128) or (ll>127) Then
  655. RunError(106);
  656. l:=ll;
  657. End;
  658. {$IFDEF VER_ABOVE0_9_8}
  659. Procedure r(var f : TextRec;var l : cardinal);[Public,Alias: 'READ_TEXT_CARDINAL'];
  660. var
  661. hs : String;
  662. code : Word;
  663. base : longint;
  664. Begin
  665. l:=0;
  666. hs:='';
  667. if not OpenInput(f) then
  668. exit;
  669. if IgnoreSpaces(f) and ReadSign(f,hs) and ReadBase(f,hs,Base) then
  670. ReadNumeric(f,hs,Base);
  671. val(hs,l,code);
  672. If code<>0 Then
  673. RunError(106);
  674. End;
  675. {$ENDIF VER_ABOVE0_9_8}
  676. Procedure r(var f : TextRec;var d : Real);[Public,Alias: 'READ_TEXT_REAL'];
  677. var
  678. hs : String;
  679. code : Word;
  680. Begin
  681. d:=0.0;
  682. hs:='';
  683. if not OpenInput(f) then
  684. exit;
  685. if IgnoreSpaces(f) and ReadSign(f,hs) and ReadNumeric(f,hs,10) then
  686. begin
  687. { First check for a . }
  688. if (f.Bufptr^[f.BufPos]='.') and (f.BufPos<f.BufEnd) Then
  689. begin
  690. hs:=hs+'.';
  691. Inc(f.BufPos);
  692. If f.BufPos>=f.BufEnd Then
  693. FileFunc(f.InOutFunc)(f);
  694. ReadNumeric(f,hs,10);
  695. end;
  696. { Also when a point is found check for a E }
  697. if (f.Bufptr^[f.BufPos] in ['e','E']) and (f.BufPos<f.BufEnd) Then
  698. begin
  699. hs:=hs+'E';
  700. Inc(f.BufPos);
  701. If f.BufPos>=f.BufEnd Then
  702. FileFunc(f.InOutFunc)(f);
  703. if ReadSign(f,hs) then
  704. ReadNumeric(f,hs,10);
  705. end;
  706. end;
  707. val(hs,d,code);
  708. If code<>0 Then
  709. RunError(106);
  710. End;
  711. {
  712. $Log$
  713. Revision 1.1 1998-03-25 11:18:43 root
  714. Initial revision
  715. Revision 1.13 1998/03/19 12:00:42 pierre
  716. * missing write for comp fixed
  717. was just a conditionnal mistyping !!
  718. Revision 1.12 1998/03/16 23:36:37 peter
  719. * fixed read(real) for a value with a . and a E
  720. Revision 1.11 1998/02/23 14:43:23 carl
  721. * bugfix of reading reals for non-i386 processors
  722. Revision 1.10 1998/02/23 02:19:53 carl
  723. * bugfix of writing real under non-i386 processors.
  724. Revision 1.9 1998/02/12 11:05:27 michael
  725. * fixed printing of cardinals
  726. Revision 1.8 1998/02/04 09:54:22 michael
  727. * fixed bug in reading of numeric input
  728. Revision 1.7 1998/01/27 17:46:10 peter
  729. * previous commit was the wrong file :(
  730. Revision 1.6 1998/01/27 12:46:06 peter
  731. * Fixed readln() from file which was broken after previous fix
  732. Revision 1.5 1998/01/27 10:56:12 peter
  733. * Readln; works again
  734. Revision 1.4 1998/01/26 12:00:28 michael
  735. + Added log at the end
  736. revision 1.3
  737. date: 1998/01/25 21:53:30; author: peter; state: Exp; lines: +9 -7
  738. + Universal Handles support for StdIn/StdOut/StdErr
  739. * Updated layout of sysamiga.pas
  740. revision 1.2
  741. date: 1998/01/12 02:32:36; author: carl; state: Exp; lines: +5 -3
  742. + portability stuff (mainly FPU related)
  743. revision 1.1
  744. date: 1998/01/11 02:43:10; author: michael; state: Exp;
  745. + Initial implementation of these files (by Peter Vreman).
  746. file operations are now in separate files per type of file.
  747. }