Mercurial > hg > CbC > CbC_gcc
comparison gcc/ada/libgnat/a-textio.adb @ 111:04ced10e8804
gcc 7
author | kono |
---|---|
date | Fri, 27 Oct 2017 22:46:09 +0900 |
parents | |
children | 84e7813d76e9 |
comparison
equal
deleted
inserted
replaced
68:561a7518be6b | 111:04ced10e8804 |
---|---|
1 ------------------------------------------------------------------------------ | |
2 -- -- | |
3 -- GNAT RUN-TIME COMPONENTS -- | |
4 -- -- | |
5 -- A D A . T E X T _ I O -- | |
6 -- -- | |
7 -- B o d y -- | |
8 -- -- | |
9 -- Copyright (C) 1992-2017, Free Software Foundation, Inc. -- | |
10 -- -- | |
11 -- GNAT is free software; you can redistribute it and/or modify it under -- | |
12 -- terms of the GNU General Public License as published by the Free Soft- -- | |
13 -- ware Foundation; either version 3, or (at your option) any later ver- -- | |
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- | |
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- | |
16 -- or FITNESS FOR A PARTICULAR PURPOSE. -- | |
17 -- -- | |
18 -- As a special exception under Section 7 of GPL version 3, you are granted -- | |
19 -- additional permissions described in the GCC Runtime Library Exception, -- | |
20 -- version 3.1, as published by the Free Software Foundation. -- | |
21 -- -- | |
22 -- You should have received a copy of the GNU General Public License and -- | |
23 -- a copy of the GCC Runtime Library Exception along with this program; -- | |
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
25 -- <http://www.gnu.org/licenses/>. -- | |
26 -- -- | |
27 -- GNAT was originally developed by the GNAT team at New York University. -- | |
28 -- Extensive contributions were provided by Ada Core Technologies Inc. -- | |
29 -- -- | |
30 ------------------------------------------------------------------------------ | |
31 | |
32 with Ada.Streams; use Ada.Streams; | |
33 with Interfaces.C_Streams; use Interfaces.C_Streams; | |
34 | |
35 with System.File_IO; | |
36 with System.CRTL; | |
37 with System.WCh_Cnv; use System.WCh_Cnv; | |
38 with System.WCh_Con; use System.WCh_Con; | |
39 | |
40 with Ada.Unchecked_Conversion; | |
41 with Ada.Unchecked_Deallocation; | |
42 | |
43 pragma Elaborate_All (System.File_IO); | |
44 -- Needed because of calls to Chain_File in package body elaboration | |
45 | |
46 package body Ada.Text_IO is | |
47 | |
48 package FIO renames System.File_IO; | |
49 | |
50 subtype AP is FCB.AFCB_Ptr; | |
51 | |
52 function To_FCB is new Ada.Unchecked_Conversion (File_Mode, FCB.File_Mode); | |
53 function To_TIO is new Ada.Unchecked_Conversion (FCB.File_Mode, File_Mode); | |
54 use type FCB.File_Mode; | |
55 | |
56 use type System.CRTL.size_t; | |
57 | |
58 WC_Encoding : Character; | |
59 pragma Import (C, WC_Encoding, "__gl_wc_encoding"); | |
60 -- Default wide character encoding | |
61 | |
62 Err_Name : aliased String := "*stderr" & ASCII.NUL; | |
63 In_Name : aliased String := "*stdin" & ASCII.NUL; | |
64 Out_Name : aliased String := "*stdout" & ASCII.NUL; | |
65 -- Names of standard files | |
66 -- | |
67 -- Use "preallocated" strings to avoid calling "new" during the elaboration | |
68 -- of the run time. This is needed in the tasking case to avoid calling | |
69 -- Task_Lock too early. A filename is expected to end with a null character | |
70 -- in the runtime, here the null characters are added just to have a | |
71 -- correct filename length. | |
72 -- | |
73 -- Note: the names for these files are bogus, and probably it would be | |
74 -- better for these files to have no names, but the ACVC tests insist. | |
75 -- We use names that are bound to fail in open etc. | |
76 | |
77 Null_Str : aliased constant String := ""; | |
78 -- Used as form string for standard files | |
79 | |
80 ----------------------- | |
81 -- Local Subprograms -- | |
82 ----------------------- | |
83 | |
84 function Get_Upper_Half_Char | |
85 (C : Character; | |
86 File : File_Type) return Character; | |
87 -- This function is shared by Get and Get_Immediate to extract an encoded | |
88 -- upper half character value from the given File. The first byte has | |
89 -- already been read and is passed in C. The character value is returned as | |
90 -- the result, and the file pointer is bumped past the character. | |
91 -- Constraint_Error is raised if the encoded value is outside the bounds of | |
92 -- type Character. | |
93 | |
94 function Get_Upper_Half_Char_Immed | |
95 (C : Character; | |
96 File : File_Type) return Character; | |
97 -- This routine is identical to Get_Upper_Half_Char, except that the reads | |
98 -- are done in Get_Immediate mode (i.e. without waiting for a line return). | |
99 | |
100 function Getc (File : File_Type) return int; | |
101 -- Gets next character from file, which has already been checked for being | |
102 -- in read status, and returns the character read if no error occurs. The | |
103 -- result is EOF if the end of file was read. | |
104 | |
105 function Getc_Immed (File : File_Type) return int; | |
106 -- This routine is identical to Getc, except that the read is done in | |
107 -- Get_Immediate mode (i.e. without waiting for a line return). | |
108 | |
109 function Has_Upper_Half_Character (Item : String) return Boolean; | |
110 -- Returns True if any of the characters is in the range 16#80#-16#FF# | |
111 | |
112 function Nextc (File : File_Type) return int; | |
113 -- Returns next character from file without skipping past it (i.e. it is a | |
114 -- combination of Getc followed by an Ungetc). | |
115 | |
116 procedure Put_Encoded (File : File_Type; Char : Character); | |
117 -- Called to output a character Char to the given File, when the encoding | |
118 -- method for the file is other than brackets, and Char is upper half. | |
119 | |
120 procedure Putc (ch : int; File : File_Type); | |
121 -- Outputs the given character to the file, which has already been checked | |
122 -- for being in output status. Device_Error is raised if the character | |
123 -- cannot be written. | |
124 | |
125 procedure Set_WCEM (File : in out File_Type); | |
126 -- Called by Open and Create to set the wide character encoding method for | |
127 -- the file, processing a WCEM form parameter if one is present. File is | |
128 -- IN OUT because it may be closed in case of an error. | |
129 | |
130 procedure Terminate_Line (File : File_Type); | |
131 -- If the file is in Write_File or Append_File mode, and the current line | |
132 -- is not terminated, then a line terminator is written using New_Line. | |
133 -- Note that there is no Terminate_Page routine, because the page mark at | |
134 -- the end of the file is implied if necessary. | |
135 | |
136 procedure Ungetc (ch : int; File : File_Type); | |
137 -- Pushes back character into stream, using ungetc. The caller has checked | |
138 -- that the file is in read status. Device_Error is raised if the character | |
139 -- cannot be pushed back. An attempt to push back and end of file character | |
140 -- (EOF) is ignored. | |
141 | |
142 ------------------- | |
143 -- AFCB_Allocate -- | |
144 ------------------- | |
145 | |
146 function AFCB_Allocate (Control_Block : Text_AFCB) return FCB.AFCB_Ptr is | |
147 pragma Unreferenced (Control_Block); | |
148 begin | |
149 return new Text_AFCB; | |
150 end AFCB_Allocate; | |
151 | |
152 ---------------- | |
153 -- AFCB_Close -- | |
154 ---------------- | |
155 | |
156 procedure AFCB_Close (File : not null access Text_AFCB) is | |
157 begin | |
158 -- If the file being closed is one of the current files, then close | |
159 -- the corresponding current file. It is not clear that this action | |
160 -- is required (RM A.10.3(23)) but it seems reasonable, and besides | |
161 -- ACVC test CE3208A expects this behavior. | |
162 | |
163 if File_Type (File) = Current_In then | |
164 Current_In := null; | |
165 elsif File_Type (File) = Current_Out then | |
166 Current_Out := null; | |
167 elsif File_Type (File) = Current_Err then | |
168 Current_Err := null; | |
169 end if; | |
170 | |
171 Terminate_Line (File_Type (File)); | |
172 end AFCB_Close; | |
173 | |
174 --------------- | |
175 -- AFCB_Free -- | |
176 --------------- | |
177 | |
178 procedure AFCB_Free (File : not null access Text_AFCB) is | |
179 type FCB_Ptr is access all Text_AFCB; | |
180 FT : FCB_Ptr := FCB_Ptr (File); | |
181 | |
182 procedure Free is new Ada.Unchecked_Deallocation (Text_AFCB, FCB_Ptr); | |
183 | |
184 begin | |
185 Free (FT); | |
186 end AFCB_Free; | |
187 | |
188 ----------- | |
189 -- Close -- | |
190 ----------- | |
191 | |
192 procedure Close (File : in out File_Type) is | |
193 begin | |
194 FIO.Close (AP (File)'Unrestricted_Access); | |
195 end Close; | |
196 | |
197 --------- | |
198 -- Col -- | |
199 --------- | |
200 | |
201 -- Note: we assume that it is impossible in practice for the column | |
202 -- to exceed the value of Count'Last, i.e. no check is required for | |
203 -- overflow raising layout error. | |
204 | |
205 function Col (File : File_Type) return Positive_Count is | |
206 begin | |
207 FIO.Check_File_Open (AP (File)); | |
208 return File.Col; | |
209 end Col; | |
210 | |
211 function Col return Positive_Count is | |
212 begin | |
213 return Col (Current_Out); | |
214 end Col; | |
215 | |
216 ------------ | |
217 -- Create -- | |
218 ------------ | |
219 | |
220 procedure Create | |
221 (File : in out File_Type; | |
222 Mode : File_Mode := Out_File; | |
223 Name : String := ""; | |
224 Form : String := "") | |
225 is | |
226 Dummy_File_Control_Block : Text_AFCB; | |
227 pragma Warnings (Off, Dummy_File_Control_Block); | |
228 -- Yes, we know this is never assigned a value, only the tag | |
229 -- is used for dispatching purposes, so that's expected. | |
230 | |
231 begin | |
232 FIO.Open (File_Ptr => AP (File), | |
233 Dummy_FCB => Dummy_File_Control_Block, | |
234 Mode => To_FCB (Mode), | |
235 Name => Name, | |
236 Form => Form, | |
237 Amethod => 'T', | |
238 Creat => True, | |
239 Text => True); | |
240 | |
241 File.Self := File; | |
242 Set_WCEM (File); | |
243 end Create; | |
244 | |
245 ------------------- | |
246 -- Current_Error -- | |
247 ------------------- | |
248 | |
249 function Current_Error return File_Type is | |
250 begin | |
251 return Current_Err; | |
252 end Current_Error; | |
253 | |
254 function Current_Error return File_Access is | |
255 begin | |
256 return Current_Err.Self'Access; | |
257 end Current_Error; | |
258 | |
259 ------------------- | |
260 -- Current_Input -- | |
261 ------------------- | |
262 | |
263 function Current_Input return File_Type is | |
264 begin | |
265 return Current_In; | |
266 end Current_Input; | |
267 | |
268 function Current_Input return File_Access is | |
269 begin | |
270 return Current_In.Self'Access; | |
271 end Current_Input; | |
272 | |
273 -------------------- | |
274 -- Current_Output -- | |
275 -------------------- | |
276 | |
277 function Current_Output return File_Type is | |
278 begin | |
279 return Current_Out; | |
280 end Current_Output; | |
281 | |
282 function Current_Output return File_Access is | |
283 begin | |
284 return Current_Out.Self'Access; | |
285 end Current_Output; | |
286 | |
287 ------------ | |
288 -- Delete -- | |
289 ------------ | |
290 | |
291 procedure Delete (File : in out File_Type) is | |
292 begin | |
293 FIO.Delete (AP (File)'Unrestricted_Access); | |
294 end Delete; | |
295 | |
296 ----------------- | |
297 -- End_Of_File -- | |
298 ----------------- | |
299 | |
300 function End_Of_File (File : File_Type) return Boolean is | |
301 ch : int; | |
302 | |
303 begin | |
304 FIO.Check_Read_Status (AP (File)); | |
305 | |
306 if File.Before_Upper_Half_Character then | |
307 return False; | |
308 | |
309 elsif File.Before_LM then | |
310 if File.Before_LM_PM then | |
311 return Nextc (File) = EOF; | |
312 end if; | |
313 | |
314 else | |
315 ch := Getc (File); | |
316 | |
317 if ch = EOF then | |
318 return True; | |
319 | |
320 elsif ch /= LM then | |
321 Ungetc (ch, File); | |
322 return False; | |
323 | |
324 else -- ch = LM | |
325 File.Before_LM := True; | |
326 end if; | |
327 end if; | |
328 | |
329 -- Here we are just past the line mark with Before_LM set so that we | |
330 -- do not have to try to back up past the LM, thus avoiding the need | |
331 -- to back up more than one character. | |
332 | |
333 ch := Getc (File); | |
334 | |
335 if ch = EOF then | |
336 return True; | |
337 | |
338 elsif ch = PM and then File.Is_Regular_File then | |
339 File.Before_LM_PM := True; | |
340 return Nextc (File) = EOF; | |
341 | |
342 -- Here if neither EOF nor PM followed end of line | |
343 | |
344 else | |
345 Ungetc (ch, File); | |
346 return False; | |
347 end if; | |
348 | |
349 end End_Of_File; | |
350 | |
351 function End_Of_File return Boolean is | |
352 begin | |
353 return End_Of_File (Current_In); | |
354 end End_Of_File; | |
355 | |
356 ----------------- | |
357 -- End_Of_Line -- | |
358 ----------------- | |
359 | |
360 function End_Of_Line (File : File_Type) return Boolean is | |
361 ch : int; | |
362 | |
363 begin | |
364 FIO.Check_Read_Status (AP (File)); | |
365 | |
366 if File.Before_Upper_Half_Character then | |
367 return False; | |
368 | |
369 elsif File.Before_LM then | |
370 return True; | |
371 | |
372 else | |
373 ch := Getc (File); | |
374 | |
375 if ch = EOF then | |
376 return True; | |
377 | |
378 else | |
379 Ungetc (ch, File); | |
380 return (ch = LM); | |
381 end if; | |
382 end if; | |
383 end End_Of_Line; | |
384 | |
385 function End_Of_Line return Boolean is | |
386 begin | |
387 return End_Of_Line (Current_In); | |
388 end End_Of_Line; | |
389 | |
390 ----------------- | |
391 -- End_Of_Page -- | |
392 ----------------- | |
393 | |
394 function End_Of_Page (File : File_Type) return Boolean is | |
395 ch : int; | |
396 | |
397 begin | |
398 FIO.Check_Read_Status (AP (File)); | |
399 | |
400 if not File.Is_Regular_File then | |
401 return False; | |
402 | |
403 elsif File.Before_Upper_Half_Character then | |
404 return False; | |
405 | |
406 elsif File.Before_LM then | |
407 if File.Before_LM_PM then | |
408 return True; | |
409 end if; | |
410 | |
411 else | |
412 ch := Getc (File); | |
413 | |
414 if ch = EOF then | |
415 return True; | |
416 | |
417 elsif ch /= LM then | |
418 Ungetc (ch, File); | |
419 return False; | |
420 | |
421 else -- ch = LM | |
422 File.Before_LM := True; | |
423 end if; | |
424 end if; | |
425 | |
426 -- Here we are just past the line mark with Before_LM set so that we | |
427 -- do not have to try to back up past the LM, thus avoiding the need | |
428 -- to back up more than one character. | |
429 | |
430 ch := Nextc (File); | |
431 | |
432 return ch = PM or else ch = EOF; | |
433 end End_Of_Page; | |
434 | |
435 function End_Of_Page return Boolean is | |
436 begin | |
437 return End_Of_Page (Current_In); | |
438 end End_Of_Page; | |
439 | |
440 -------------- | |
441 -- EOF_Char -- | |
442 -------------- | |
443 | |
444 function EOF_Char return Integer is | |
445 begin | |
446 return EOF; | |
447 end EOF_Char; | |
448 | |
449 ----------- | |
450 -- Flush -- | |
451 ----------- | |
452 | |
453 procedure Flush (File : File_Type) is | |
454 begin | |
455 FIO.Flush (AP (File)); | |
456 end Flush; | |
457 | |
458 procedure Flush is | |
459 begin | |
460 Flush (Current_Out); | |
461 end Flush; | |
462 | |
463 ---------- | |
464 -- Form -- | |
465 ---------- | |
466 | |
467 function Form (File : File_Type) return String is | |
468 begin | |
469 return FIO.Form (AP (File)); | |
470 end Form; | |
471 | |
472 --------- | |
473 -- Get -- | |
474 --------- | |
475 | |
476 procedure Get | |
477 (File : File_Type; | |
478 Item : out Character) | |
479 is | |
480 ch : int; | |
481 | |
482 begin | |
483 FIO.Check_Read_Status (AP (File)); | |
484 | |
485 if File.Before_Upper_Half_Character then | |
486 File.Before_Upper_Half_Character := False; | |
487 Item := File.Saved_Upper_Half_Character; | |
488 | |
489 elsif File.Before_LM then | |
490 File.Before_LM := False; | |
491 File.Col := 1; | |
492 | |
493 if File.Before_LM_PM then | |
494 File.Line := 1; | |
495 File.Page := File.Page + 1; | |
496 File.Before_LM_PM := False; | |
497 else | |
498 File.Line := File.Line + 1; | |
499 end if; | |
500 end if; | |
501 | |
502 loop | |
503 ch := Getc (File); | |
504 | |
505 if ch = EOF then | |
506 raise End_Error; | |
507 | |
508 elsif ch = LM then | |
509 File.Line := File.Line + 1; | |
510 File.Col := 1; | |
511 | |
512 elsif ch = PM and then File.Is_Regular_File then | |
513 File.Page := File.Page + 1; | |
514 File.Line := 1; | |
515 | |
516 else | |
517 Item := Character'Val (ch); | |
518 File.Col := File.Col + 1; | |
519 return; | |
520 end if; | |
521 end loop; | |
522 end Get; | |
523 | |
524 procedure Get (Item : out Character) is | |
525 begin | |
526 Get (Current_In, Item); | |
527 end Get; | |
528 | |
529 procedure Get | |
530 (File : File_Type; | |
531 Item : out String) | |
532 is | |
533 ch : int; | |
534 J : Natural; | |
535 | |
536 begin | |
537 FIO.Check_Read_Status (AP (File)); | |
538 | |
539 if File.Before_LM then | |
540 File.Before_LM := False; | |
541 File.Before_LM_PM := False; | |
542 File.Col := 1; | |
543 | |
544 if File.Before_LM_PM then | |
545 File.Line := 1; | |
546 File.Page := File.Page + 1; | |
547 File.Before_LM_PM := False; | |
548 | |
549 else | |
550 File.Line := File.Line + 1; | |
551 end if; | |
552 end if; | |
553 | |
554 J := Item'First; | |
555 while J <= Item'Last loop | |
556 ch := Getc (File); | |
557 | |
558 if ch = EOF then | |
559 raise End_Error; | |
560 | |
561 elsif ch = LM then | |
562 File.Line := File.Line + 1; | |
563 File.Col := 1; | |
564 | |
565 elsif ch = PM and then File.Is_Regular_File then | |
566 File.Page := File.Page + 1; | |
567 File.Line := 1; | |
568 | |
569 else | |
570 Item (J) := Character'Val (ch); | |
571 J := J + 1; | |
572 File.Col := File.Col + 1; | |
573 end if; | |
574 end loop; | |
575 end Get; | |
576 | |
577 procedure Get (Item : out String) is | |
578 begin | |
579 Get (Current_In, Item); | |
580 end Get; | |
581 | |
582 ------------------- | |
583 -- Get_Immediate -- | |
584 ------------------- | |
585 | |
586 procedure Get_Immediate | |
587 (File : File_Type; | |
588 Item : out Character) | |
589 is | |
590 ch : int; | |
591 | |
592 begin | |
593 FIO.Check_Read_Status (AP (File)); | |
594 | |
595 if File.Before_Upper_Half_Character then | |
596 File.Before_Upper_Half_Character := False; | |
597 Item := File.Saved_Upper_Half_Character; | |
598 | |
599 elsif File.Before_LM then | |
600 File.Before_LM := False; | |
601 File.Before_LM_PM := False; | |
602 Item := Character'Val (LM); | |
603 | |
604 else | |
605 ch := Getc_Immed (File); | |
606 | |
607 if ch = EOF then | |
608 raise End_Error; | |
609 else | |
610 Item := | |
611 (if not Is_Start_Of_Encoding (Character'Val (ch), File.WC_Method) | |
612 then Character'Val (ch) | |
613 else Get_Upper_Half_Char_Immed (Character'Val (ch), File)); | |
614 end if; | |
615 end if; | |
616 end Get_Immediate; | |
617 | |
618 procedure Get_Immediate | |
619 (Item : out Character) | |
620 is | |
621 begin | |
622 Get_Immediate (Current_In, Item); | |
623 end Get_Immediate; | |
624 | |
625 procedure Get_Immediate | |
626 (File : File_Type; | |
627 Item : out Character; | |
628 Available : out Boolean) | |
629 is | |
630 ch : int; | |
631 end_of_file : int; | |
632 avail : int; | |
633 | |
634 procedure getc_immediate_nowait | |
635 (stream : FILEs; | |
636 ch : out int; | |
637 end_of_file : out int; | |
638 avail : out int); | |
639 pragma Import (C, getc_immediate_nowait, "getc_immediate_nowait"); | |
640 | |
641 begin | |
642 FIO.Check_Read_Status (AP (File)); | |
643 Available := True; | |
644 | |
645 if File.Before_Upper_Half_Character then | |
646 File.Before_Upper_Half_Character := False; | |
647 Item := File.Saved_Upper_Half_Character; | |
648 | |
649 elsif File.Before_LM then | |
650 File.Before_LM := False; | |
651 File.Before_LM_PM := False; | |
652 Item := Character'Val (LM); | |
653 | |
654 else | |
655 getc_immediate_nowait (File.Stream, ch, end_of_file, avail); | |
656 | |
657 if ferror (File.Stream) /= 0 then | |
658 raise Device_Error; | |
659 | |
660 elsif end_of_file /= 0 then | |
661 raise End_Error; | |
662 | |
663 elsif avail = 0 then | |
664 Available := False; | |
665 Item := ASCII.NUL; | |
666 | |
667 else | |
668 Available := True; | |
669 | |
670 Item := | |
671 (if not Is_Start_Of_Encoding (Character'Val (ch), File.WC_Method) | |
672 then Character'Val (ch) | |
673 else Get_Upper_Half_Char_Immed (Character'Val (ch), File)); | |
674 end if; | |
675 end if; | |
676 | |
677 end Get_Immediate; | |
678 | |
679 procedure Get_Immediate | |
680 (Item : out Character; | |
681 Available : out Boolean) | |
682 is | |
683 begin | |
684 Get_Immediate (Current_In, Item, Available); | |
685 end Get_Immediate; | |
686 | |
687 -------------- | |
688 -- Get_Line -- | |
689 -------------- | |
690 | |
691 procedure Get_Line | |
692 (File : File_Type; | |
693 Item : out String; | |
694 Last : out Natural) is separate; | |
695 -- The implementation of Ada.Text_IO.Get_Line is split into a subunit so | |
696 -- that different implementations can be used on different systems. | |
697 | |
698 procedure Get_Line | |
699 (Item : out String; | |
700 Last : out Natural) | |
701 is | |
702 begin | |
703 Get_Line (Current_In, Item, Last); | |
704 end Get_Line; | |
705 | |
706 function Get_Line (File : File_Type) return String is | |
707 function Get_Rest (S : String) return String; | |
708 -- This is a recursive function that reads the rest of the line and | |
709 -- returns it. S is the part read so far. | |
710 | |
711 -------------- | |
712 -- Get_Rest -- | |
713 -------------- | |
714 | |
715 function Get_Rest (S : String) return String is | |
716 | |
717 -- The first time we allocate a buffer of size 500. Each following | |
718 -- time we allocate a buffer the same size as what we have read so | |
719 -- far. This limits us to a logarithmic number of calls to Get_Rest | |
720 -- and also ensures only a linear use of stack space. | |
721 | |
722 Buffer : String (1 .. Integer'Max (500, S'Length)); | |
723 Last : Natural; | |
724 | |
725 begin | |
726 Get_Line (File, Buffer, Last); | |
727 | |
728 declare | |
729 R : constant String := S & Buffer (1 .. Last); | |
730 begin | |
731 if Last < Buffer'Last then | |
732 return R; | |
733 | |
734 else | |
735 pragma Assert (Last = Buffer'Last); | |
736 | |
737 -- If the String has the same length as the buffer, and there | |
738 -- is no end of line, check whether we are at the end of file, | |
739 -- in which case we have the full String in the buffer. | |
740 | |
741 if End_Of_File (File) then | |
742 return R; | |
743 | |
744 else | |
745 return Get_Rest (R); | |
746 end if; | |
747 end if; | |
748 end; | |
749 end Get_Rest; | |
750 | |
751 -- Start of processing for Get_Line | |
752 | |
753 begin | |
754 return Get_Rest (""); | |
755 end Get_Line; | |
756 | |
757 function Get_Line return String is | |
758 begin | |
759 return Get_Line (Current_In); | |
760 end Get_Line; | |
761 | |
762 ------------------------- | |
763 -- Get_Upper_Half_Char -- | |
764 ------------------------- | |
765 | |
766 function Get_Upper_Half_Char | |
767 (C : Character; | |
768 File : File_Type) return Character | |
769 is | |
770 Result : Wide_Character; | |
771 | |
772 function In_Char return Character; | |
773 -- Function used to obtain additional characters it the wide character | |
774 -- sequence is more than one character long. | |
775 | |
776 function WC_In is new Char_Sequence_To_Wide_Char (In_Char); | |
777 | |
778 ------------- | |
779 -- In_Char -- | |
780 ------------- | |
781 | |
782 function In_Char return Character is | |
783 ch : constant Integer := Getc (File); | |
784 begin | |
785 if ch = EOF then | |
786 raise End_Error; | |
787 else | |
788 return Character'Val (ch); | |
789 end if; | |
790 end In_Char; | |
791 | |
792 -- Start of processing for Get_Upper_Half_Char | |
793 | |
794 begin | |
795 Result := WC_In (C, File.WC_Method); | |
796 | |
797 if Wide_Character'Pos (Result) > 16#FF# then | |
798 raise Constraint_Error with | |
799 "invalid wide character in Text_'I'O input"; | |
800 else | |
801 return Character'Val (Wide_Character'Pos (Result)); | |
802 end if; | |
803 end Get_Upper_Half_Char; | |
804 | |
805 ------------------------------- | |
806 -- Get_Upper_Half_Char_Immed -- | |
807 ------------------------------- | |
808 | |
809 function Get_Upper_Half_Char_Immed | |
810 (C : Character; | |
811 File : File_Type) return Character | |
812 is | |
813 Result : Wide_Character; | |
814 | |
815 function In_Char return Character; | |
816 -- Function used to obtain additional characters it the wide character | |
817 -- sequence is more than one character long. | |
818 | |
819 function WC_In is new Char_Sequence_To_Wide_Char (In_Char); | |
820 | |
821 ------------- | |
822 -- In_Char -- | |
823 ------------- | |
824 | |
825 function In_Char return Character is | |
826 ch : constant Integer := Getc_Immed (File); | |
827 begin | |
828 if ch = EOF then | |
829 raise End_Error; | |
830 else | |
831 return Character'Val (ch); | |
832 end if; | |
833 end In_Char; | |
834 | |
835 -- Start of processing for Get_Upper_Half_Char_Immed | |
836 | |
837 begin | |
838 Result := WC_In (C, File.WC_Method); | |
839 | |
840 if Wide_Character'Pos (Result) > 16#FF# then | |
841 raise Constraint_Error with | |
842 "invalid wide character in Text_'I'O input"; | |
843 else | |
844 return Character'Val (Wide_Character'Pos (Result)); | |
845 end if; | |
846 end Get_Upper_Half_Char_Immed; | |
847 | |
848 ---------- | |
849 -- Getc -- | |
850 ---------- | |
851 | |
852 function Getc (File : File_Type) return int is | |
853 ch : int; | |
854 | |
855 begin | |
856 ch := fgetc (File.Stream); | |
857 | |
858 if ch = EOF and then ferror (File.Stream) /= 0 then | |
859 raise Device_Error; | |
860 else | |
861 return ch; | |
862 end if; | |
863 end Getc; | |
864 | |
865 ---------------- | |
866 -- Getc_Immed -- | |
867 ---------------- | |
868 | |
869 function Getc_Immed (File : File_Type) return int is | |
870 ch : int; | |
871 end_of_file : int; | |
872 | |
873 procedure getc_immediate | |
874 (stream : FILEs; ch : out int; end_of_file : out int); | |
875 pragma Import (C, getc_immediate, "getc_immediate"); | |
876 | |
877 begin | |
878 FIO.Check_Read_Status (AP (File)); | |
879 | |
880 if File.Before_LM then | |
881 File.Before_LM := False; | |
882 File.Before_LM_PM := False; | |
883 ch := LM; | |
884 | |
885 else | |
886 getc_immediate (File.Stream, ch, end_of_file); | |
887 | |
888 if ferror (File.Stream) /= 0 then | |
889 raise Device_Error; | |
890 elsif end_of_file /= 0 then | |
891 return EOF; | |
892 end if; | |
893 end if; | |
894 | |
895 return ch; | |
896 end Getc_Immed; | |
897 | |
898 ------------------------------ | |
899 -- Has_Upper_Half_Character -- | |
900 ------------------------------ | |
901 | |
902 function Has_Upper_Half_Character (Item : String) return Boolean is | |
903 begin | |
904 for J in Item'Range loop | |
905 if Character'Pos (Item (J)) >= 16#80# then | |
906 return True; | |
907 end if; | |
908 end loop; | |
909 | |
910 return False; | |
911 end Has_Upper_Half_Character; | |
912 | |
913 ------------------------------- | |
914 -- Initialize_Standard_Files -- | |
915 ------------------------------- | |
916 | |
917 procedure Initialize_Standard_Files is | |
918 begin | |
919 Standard_Err.Stream := stderr; | |
920 Standard_Err.Name := Err_Name'Access; | |
921 Standard_Err.Form := Null_Str'Unrestricted_Access; | |
922 Standard_Err.Mode := FCB.Out_File; | |
923 Standard_Err.Is_Regular_File := is_regular_file (fileno (stderr)) /= 0; | |
924 Standard_Err.Is_Temporary_File := False; | |
925 Standard_Err.Is_System_File := True; | |
926 Standard_Err.Text_Encoding := Default_Text; | |
927 Standard_Err.Access_Method := 'T'; | |
928 Standard_Err.Self := Standard_Err; | |
929 Standard_Err.WC_Method := Default_WCEM; | |
930 | |
931 Standard_In.Stream := stdin; | |
932 Standard_In.Name := In_Name'Access; | |
933 Standard_In.Form := Null_Str'Unrestricted_Access; | |
934 Standard_In.Mode := FCB.In_File; | |
935 Standard_In.Is_Regular_File := is_regular_file (fileno (stdin)) /= 0; | |
936 Standard_In.Is_Temporary_File := False; | |
937 Standard_In.Is_System_File := True; | |
938 Standard_In.Text_Encoding := Default_Text; | |
939 Standard_In.Access_Method := 'T'; | |
940 Standard_In.Self := Standard_In; | |
941 Standard_In.WC_Method := Default_WCEM; | |
942 | |
943 Standard_Out.Stream := stdout; | |
944 Standard_Out.Name := Out_Name'Access; | |
945 Standard_Out.Form := Null_Str'Unrestricted_Access; | |
946 Standard_Out.Mode := FCB.Out_File; | |
947 Standard_Out.Is_Regular_File := is_regular_file (fileno (stdout)) /= 0; | |
948 Standard_Out.Is_Temporary_File := False; | |
949 Standard_Out.Is_System_File := True; | |
950 Standard_Out.Text_Encoding := Default_Text; | |
951 Standard_Out.Access_Method := 'T'; | |
952 Standard_Out.Self := Standard_Out; | |
953 Standard_Out.WC_Method := Default_WCEM; | |
954 | |
955 FIO.Make_Unbuffered (AP (Standard_Out)); | |
956 FIO.Make_Unbuffered (AP (Standard_Err)); | |
957 end Initialize_Standard_Files; | |
958 | |
959 ------------- | |
960 -- Is_Open -- | |
961 ------------- | |
962 | |
963 function Is_Open (File : File_Type) return Boolean is | |
964 begin | |
965 return FIO.Is_Open (AP (File)); | |
966 end Is_Open; | |
967 | |
968 ---------- | |
969 -- Line -- | |
970 ---------- | |
971 | |
972 -- Note: we assume that it is impossible in practice for the line | |
973 -- to exceed the value of Count'Last, i.e. no check is required for | |
974 -- overflow raising layout error. | |
975 | |
976 function Line (File : File_Type) return Positive_Count is | |
977 begin | |
978 FIO.Check_File_Open (AP (File)); | |
979 return File.Line; | |
980 end Line; | |
981 | |
982 function Line return Positive_Count is | |
983 begin | |
984 return Line (Current_Out); | |
985 end Line; | |
986 | |
987 ----------------- | |
988 -- Line_Length -- | |
989 ----------------- | |
990 | |
991 function Line_Length (File : File_Type) return Count is | |
992 begin | |
993 FIO.Check_Write_Status (AP (File)); | |
994 return File.Line_Length; | |
995 end Line_Length; | |
996 | |
997 function Line_Length return Count is | |
998 begin | |
999 return Line_Length (Current_Out); | |
1000 end Line_Length; | |
1001 | |
1002 ---------------- | |
1003 -- Look_Ahead -- | |
1004 ---------------- | |
1005 | |
1006 procedure Look_Ahead | |
1007 (File : File_Type; | |
1008 Item : out Character; | |
1009 End_Of_Line : out Boolean) | |
1010 is | |
1011 ch : int; | |
1012 | |
1013 begin | |
1014 FIO.Check_Read_Status (AP (File)); | |
1015 | |
1016 -- If we are logically before a line mark, we can return immediately | |
1017 | |
1018 if File.Before_LM then | |
1019 End_Of_Line := True; | |
1020 Item := ASCII.NUL; | |
1021 | |
1022 -- If we are before an upper half character just return it (this can | |
1023 -- happen if there are two calls to Look_Ahead in a row). | |
1024 | |
1025 elsif File.Before_Upper_Half_Character then | |
1026 End_Of_Line := False; | |
1027 Item := File.Saved_Upper_Half_Character; | |
1028 | |
1029 -- Otherwise we must read a character from the input stream | |
1030 | |
1031 else | |
1032 ch := Getc (File); | |
1033 | |
1034 if ch = LM | |
1035 or else ch = EOF | |
1036 or else (ch = PM and then File.Is_Regular_File) | |
1037 then | |
1038 End_Of_Line := True; | |
1039 Ungetc (ch, File); | |
1040 Item := ASCII.NUL; | |
1041 | |
1042 -- Case where character obtained does not represent the start of an | |
1043 -- encoded sequence so it stands for itself and we can unget it with | |
1044 -- no difficulty. | |
1045 | |
1046 elsif not Is_Start_Of_Encoding | |
1047 (Character'Val (ch), File.WC_Method) | |
1048 then | |
1049 End_Of_Line := False; | |
1050 Ungetc (ch, File); | |
1051 Item := Character'Val (ch); | |
1052 | |
1053 -- For the start of an encoding, we read the character using the | |
1054 -- Get_Upper_Half_Char routine. It will occupy more than one byte | |
1055 -- so we can't put it back with ungetc. Instead we save it in the | |
1056 -- control block, setting a flag that everyone interested in reading | |
1057 -- characters must test before reading the stream. | |
1058 | |
1059 else | |
1060 Item := Get_Upper_Half_Char (Character'Val (ch), File); | |
1061 End_Of_Line := False; | |
1062 File.Saved_Upper_Half_Character := Item; | |
1063 File.Before_Upper_Half_Character := True; | |
1064 end if; | |
1065 end if; | |
1066 end Look_Ahead; | |
1067 | |
1068 procedure Look_Ahead | |
1069 (Item : out Character; | |
1070 End_Of_Line : out Boolean) | |
1071 is | |
1072 begin | |
1073 Look_Ahead (Current_In, Item, End_Of_Line); | |
1074 end Look_Ahead; | |
1075 | |
1076 ---------- | |
1077 -- Mode -- | |
1078 ---------- | |
1079 | |
1080 function Mode (File : File_Type) return File_Mode is | |
1081 begin | |
1082 return To_TIO (FIO.Mode (AP (File))); | |
1083 end Mode; | |
1084 | |
1085 ---------- | |
1086 -- Name -- | |
1087 ---------- | |
1088 | |
1089 function Name (File : File_Type) return String is | |
1090 begin | |
1091 return FIO.Name (AP (File)); | |
1092 end Name; | |
1093 | |
1094 -------------- | |
1095 -- New_Line -- | |
1096 -------------- | |
1097 | |
1098 procedure New_Line | |
1099 (File : File_Type; | |
1100 Spacing : Positive_Count := 1) | |
1101 is | |
1102 begin | |
1103 -- Raise Constraint_Error if out of range value. The reason for this | |
1104 -- explicit test is that we don't want junk values around, even if | |
1105 -- checks are off in the caller. | |
1106 | |
1107 if not Spacing'Valid then | |
1108 raise Constraint_Error; | |
1109 end if; | |
1110 | |
1111 FIO.Check_Write_Status (AP (File)); | |
1112 | |
1113 for K in 1 .. Spacing loop | |
1114 Putc (LM, File); | |
1115 File.Line := File.Line + 1; | |
1116 | |
1117 if File.Page_Length /= 0 | |
1118 and then File.Line > File.Page_Length | |
1119 then | |
1120 Putc (PM, File); | |
1121 File.Line := 1; | |
1122 File.Page := File.Page + 1; | |
1123 end if; | |
1124 end loop; | |
1125 | |
1126 File.Col := 1; | |
1127 end New_Line; | |
1128 | |
1129 procedure New_Line (Spacing : Positive_Count := 1) is | |
1130 begin | |
1131 New_Line (Current_Out, Spacing); | |
1132 end New_Line; | |
1133 | |
1134 -------------- | |
1135 -- New_Page -- | |
1136 -------------- | |
1137 | |
1138 procedure New_Page (File : File_Type) is | |
1139 begin | |
1140 FIO.Check_Write_Status (AP (File)); | |
1141 | |
1142 if File.Col /= 1 or else File.Line = 1 then | |
1143 Putc (LM, File); | |
1144 end if; | |
1145 | |
1146 Putc (PM, File); | |
1147 File.Page := File.Page + 1; | |
1148 File.Line := 1; | |
1149 File.Col := 1; | |
1150 end New_Page; | |
1151 | |
1152 procedure New_Page is | |
1153 begin | |
1154 New_Page (Current_Out); | |
1155 end New_Page; | |
1156 | |
1157 ----------- | |
1158 -- Nextc -- | |
1159 ----------- | |
1160 | |
1161 function Nextc (File : File_Type) return int is | |
1162 ch : int; | |
1163 | |
1164 begin | |
1165 ch := fgetc (File.Stream); | |
1166 | |
1167 if ch = EOF then | |
1168 if ferror (File.Stream) /= 0 then | |
1169 raise Device_Error; | |
1170 end if; | |
1171 | |
1172 else | |
1173 if ungetc (ch, File.Stream) = EOF then | |
1174 raise Device_Error; | |
1175 end if; | |
1176 end if; | |
1177 | |
1178 return ch; | |
1179 end Nextc; | |
1180 | |
1181 ---------- | |
1182 -- Open -- | |
1183 ---------- | |
1184 | |
1185 procedure Open | |
1186 (File : in out File_Type; | |
1187 Mode : File_Mode; | |
1188 Name : String; | |
1189 Form : String := "") | |
1190 is | |
1191 Dummy_File_Control_Block : Text_AFCB; | |
1192 pragma Warnings (Off, Dummy_File_Control_Block); | |
1193 -- Yes, we know this is never assigned a value, only the tag | |
1194 -- is used for dispatching purposes, so that's expected. | |
1195 | |
1196 begin | |
1197 FIO.Open (File_Ptr => AP (File), | |
1198 Dummy_FCB => Dummy_File_Control_Block, | |
1199 Mode => To_FCB (Mode), | |
1200 Name => Name, | |
1201 Form => Form, | |
1202 Amethod => 'T', | |
1203 Creat => False, | |
1204 Text => True); | |
1205 | |
1206 File.Self := File; | |
1207 Set_WCEM (File); | |
1208 end Open; | |
1209 | |
1210 ---------- | |
1211 -- Page -- | |
1212 ---------- | |
1213 | |
1214 -- Note: we assume that it is impossible in practice for the page | |
1215 -- to exceed the value of Count'Last, i.e. no check is required for | |
1216 -- overflow raising layout error. | |
1217 | |
1218 function Page (File : File_Type) return Positive_Count is | |
1219 begin | |
1220 FIO.Check_File_Open (AP (File)); | |
1221 return File.Page; | |
1222 end Page; | |
1223 | |
1224 function Page return Positive_Count is | |
1225 begin | |
1226 return Page (Current_Out); | |
1227 end Page; | |
1228 | |
1229 ----------------- | |
1230 -- Page_Length -- | |
1231 ----------------- | |
1232 | |
1233 function Page_Length (File : File_Type) return Count is | |
1234 begin | |
1235 FIO.Check_Write_Status (AP (File)); | |
1236 return File.Page_Length; | |
1237 end Page_Length; | |
1238 | |
1239 function Page_Length return Count is | |
1240 begin | |
1241 return Page_Length (Current_Out); | |
1242 end Page_Length; | |
1243 | |
1244 --------- | |
1245 -- Put -- | |
1246 --------- | |
1247 | |
1248 procedure Put | |
1249 (File : File_Type; | |
1250 Item : Character) | |
1251 is | |
1252 begin | |
1253 FIO.Check_Write_Status (AP (File)); | |
1254 | |
1255 if File.Line_Length /= 0 and then File.Col > File.Line_Length then | |
1256 New_Line (File); | |
1257 end if; | |
1258 | |
1259 -- If lower half character, or brackets encoding, output directly | |
1260 | |
1261 if Character'Pos (Item) < 16#80# | |
1262 or else File.WC_Method = WCEM_Brackets | |
1263 then | |
1264 if fputc (Character'Pos (Item), File.Stream) = EOF then | |
1265 raise Device_Error; | |
1266 end if; | |
1267 | |
1268 -- Case of upper half character with non-brackets encoding | |
1269 | |
1270 else | |
1271 Put_Encoded (File, Item); | |
1272 end if; | |
1273 | |
1274 File.Col := File.Col + 1; | |
1275 end Put; | |
1276 | |
1277 procedure Put (Item : Character) is | |
1278 begin | |
1279 Put (Current_Out, Item); | |
1280 end Put; | |
1281 | |
1282 --------- | |
1283 -- Put -- | |
1284 --------- | |
1285 | |
1286 procedure Put | |
1287 (File : File_Type; | |
1288 Item : String) | |
1289 is | |
1290 begin | |
1291 FIO.Check_Write_Status (AP (File)); | |
1292 | |
1293 -- Only have something to do if string is non-null | |
1294 | |
1295 if Item'Length > 0 then | |
1296 | |
1297 -- If we have bounded lines, or if the file encoding is other than | |
1298 -- Brackets and the string has at least one upper half character, | |
1299 -- then output the string character by character. | |
1300 | |
1301 if File.Line_Length /= 0 | |
1302 or else (File.WC_Method /= WCEM_Brackets | |
1303 and then Has_Upper_Half_Character (Item)) | |
1304 then | |
1305 for J in Item'Range loop | |
1306 Put (File, Item (J)); | |
1307 end loop; | |
1308 | |
1309 -- Otherwise we can output the entire string at once. Note that if | |
1310 -- there are LF or FF characters in the string, we do not bother to | |
1311 -- count them as line or page terminators. | |
1312 | |
1313 else | |
1314 FIO.Write_Buf (AP (File), Item'Address, Item'Length); | |
1315 File.Col := File.Col + Item'Length; | |
1316 end if; | |
1317 end if; | |
1318 end Put; | |
1319 | |
1320 procedure Put (Item : String) is | |
1321 begin | |
1322 Put (Current_Out, Item); | |
1323 end Put; | |
1324 | |
1325 ----------------- | |
1326 -- Put_Encoded -- | |
1327 ----------------- | |
1328 | |
1329 procedure Put_Encoded (File : File_Type; Char : Character) is | |
1330 procedure Out_Char (C : Character); | |
1331 -- Procedure to output one character of an upper half encoded sequence | |
1332 | |
1333 procedure WC_Out is new Wide_Char_To_Char_Sequence (Out_Char); | |
1334 | |
1335 -------------- | |
1336 -- Out_Char -- | |
1337 -------------- | |
1338 | |
1339 procedure Out_Char (C : Character) is | |
1340 begin | |
1341 Putc (Character'Pos (C), File); | |
1342 end Out_Char; | |
1343 | |
1344 -- Start of processing for Put_Encoded | |
1345 | |
1346 begin | |
1347 WC_Out (Wide_Character'Val (Character'Pos (Char)), File.WC_Method); | |
1348 end Put_Encoded; | |
1349 | |
1350 -------------- | |
1351 -- Put_Line -- | |
1352 -------------- | |
1353 | |
1354 procedure Put_Line | |
1355 (File : File_Type; | |
1356 Item : String) | |
1357 is | |
1358 Ilen : Natural := Item'Length; | |
1359 Istart : Natural := Item'First; | |
1360 | |
1361 begin | |
1362 FIO.Check_Write_Status (AP (File)); | |
1363 | |
1364 -- If we have bounded lines, or if the file encoding is other than | |
1365 -- Brackets and the string has at least one upper half character, then | |
1366 -- output the string character by character. | |
1367 | |
1368 if File.Line_Length /= 0 | |
1369 or else (File.WC_Method /= WCEM_Brackets | |
1370 and then Has_Upper_Half_Character (Item)) | |
1371 then | |
1372 for J in Item'Range loop | |
1373 Put (File, Item (J)); | |
1374 end loop; | |
1375 | |
1376 New_Line (File); | |
1377 return; | |
1378 end if; | |
1379 | |
1380 -- Normal case where we do not need to output character by character | |
1381 | |
1382 -- We setup a single string that has the necessary terminators and | |
1383 -- then write it with a single call. The reason for doing this is | |
1384 -- that it gives better behavior for the use of Put_Line in multi- | |
1385 -- tasking programs, since often the OS will treat the entire put | |
1386 -- operation as an atomic operation. | |
1387 | |
1388 -- We only do this if the message is 512 characters or less in length, | |
1389 -- since otherwise Put_Line would use an unbounded amount of stack | |
1390 -- space and could cause undetected stack overflow. If we have a | |
1391 -- longer string, then output the first part separately to avoid this. | |
1392 | |
1393 if Ilen > 512 then | |
1394 FIO.Write_Buf (AP (File), Item'Address, size_t (Ilen - 512)); | |
1395 Istart := Istart + Ilen - 512; | |
1396 Ilen := 512; | |
1397 end if; | |
1398 | |
1399 -- Now prepare the string with its terminator | |
1400 | |
1401 declare | |
1402 Buffer : String (1 .. Ilen + 2); | |
1403 Plen : size_t; | |
1404 | |
1405 begin | |
1406 Buffer (1 .. Ilen) := Item (Istart .. Item'Last); | |
1407 Buffer (Ilen + 1) := Character'Val (LM); | |
1408 | |
1409 if File.Page_Length /= 0 | |
1410 and then File.Line > File.Page_Length | |
1411 then | |
1412 Buffer (Ilen + 2) := Character'Val (PM); | |
1413 Plen := size_t (Ilen) + 2; | |
1414 File.Line := 1; | |
1415 File.Page := File.Page + 1; | |
1416 | |
1417 else | |
1418 Plen := size_t (Ilen) + 1; | |
1419 File.Line := File.Line + 1; | |
1420 end if; | |
1421 | |
1422 FIO.Write_Buf (AP (File), Buffer'Address, Plen); | |
1423 | |
1424 File.Col := 1; | |
1425 end; | |
1426 end Put_Line; | |
1427 | |
1428 procedure Put_Line (Item : String) is | |
1429 begin | |
1430 Put_Line (Current_Out, Item); | |
1431 end Put_Line; | |
1432 | |
1433 ---------- | |
1434 -- Putc -- | |
1435 ---------- | |
1436 | |
1437 procedure Putc (ch : int; File : File_Type) is | |
1438 begin | |
1439 if fputc (ch, File.Stream) = EOF then | |
1440 raise Device_Error; | |
1441 end if; | |
1442 end Putc; | |
1443 | |
1444 ---------- | |
1445 -- Read -- | |
1446 ---------- | |
1447 | |
1448 -- This is the primitive Stream Read routine, used when a Text_IO file | |
1449 -- is treated directly as a stream using Text_IO.Streams.Stream. | |
1450 | |
1451 procedure Read | |
1452 (File : in out Text_AFCB; | |
1453 Item : out Stream_Element_Array; | |
1454 Last : out Stream_Element_Offset) | |
1455 is | |
1456 Discard_ch : int; | |
1457 pragma Warnings (Off, Discard_ch); | |
1458 | |
1459 begin | |
1460 -- Need to deal with Before_Upper_Half_Character ??? | |
1461 | |
1462 if File.Mode /= FCB.In_File then | |
1463 raise Mode_Error; | |
1464 end if; | |
1465 | |
1466 -- Deal with case where our logical and physical position do not match | |
1467 -- because of being after an LM or LM-PM sequence when in fact we are | |
1468 -- logically positioned before it. | |
1469 | |
1470 if File.Before_LM then | |
1471 | |
1472 -- If we are before a PM, then it is possible for a stream read | |
1473 -- to leave us after the LM and before the PM, which is a bit | |
1474 -- odd. The easiest way to deal with this is to unget the PM, | |
1475 -- so we are indeed positioned between the characters. This way | |
1476 -- further stream read operations will work correctly, and the | |
1477 -- effect on text processing is a little weird, but what can | |
1478 -- be expected if stream and text input are mixed this way? | |
1479 | |
1480 if File.Before_LM_PM then | |
1481 Discard_ch := ungetc (PM, File.Stream); | |
1482 File.Before_LM_PM := False; | |
1483 end if; | |
1484 | |
1485 File.Before_LM := False; | |
1486 | |
1487 Item (Item'First) := Stream_Element (Character'Pos (ASCII.LF)); | |
1488 | |
1489 if Item'Length = 1 then | |
1490 Last := Item'Last; | |
1491 | |
1492 else | |
1493 Last := | |
1494 Item'First + | |
1495 Stream_Element_Offset | |
1496 (fread (buffer => Item'Address, | |
1497 index => size_t (Item'First + 1), | |
1498 size => 1, | |
1499 count => Item'Length - 1, | |
1500 stream => File.Stream)); | |
1501 end if; | |
1502 | |
1503 return; | |
1504 end if; | |
1505 | |
1506 -- Now we do the read. Since this is a text file, it is normally in | |
1507 -- text mode, but stream data must be read in binary mode, so we | |
1508 -- temporarily set binary mode for the read, resetting it after. | |
1509 -- These calls have no effect in a system (like Unix) where there is | |
1510 -- no distinction between text and binary files. | |
1511 | |
1512 set_binary_mode (fileno (File.Stream)); | |
1513 | |
1514 Last := | |
1515 Item'First + | |
1516 Stream_Element_Offset | |
1517 (fread (Item'Address, 1, Item'Length, File.Stream)) - 1; | |
1518 | |
1519 if Last < Item'Last then | |
1520 if ferror (File.Stream) /= 0 then | |
1521 raise Device_Error; | |
1522 end if; | |
1523 end if; | |
1524 | |
1525 set_text_mode (fileno (File.Stream)); | |
1526 end Read; | |
1527 | |
1528 ----------- | |
1529 -- Reset -- | |
1530 ----------- | |
1531 | |
1532 procedure Reset | |
1533 (File : in out File_Type; | |
1534 Mode : File_Mode) | |
1535 is | |
1536 begin | |
1537 -- Don't allow change of mode for current file (RM A.10.2(5)) | |
1538 | |
1539 if (File = Current_In or else | |
1540 File = Current_Out or else | |
1541 File = Current_Error) | |
1542 and then To_FCB (Mode) /= File.Mode | |
1543 then | |
1544 raise Mode_Error; | |
1545 end if; | |
1546 | |
1547 Terminate_Line (File); | |
1548 FIO.Reset (AP (File)'Unrestricted_Access, To_FCB (Mode)); | |
1549 File.Page := 1; | |
1550 File.Line := 1; | |
1551 File.Col := 1; | |
1552 File.Line_Length := 0; | |
1553 File.Page_Length := 0; | |
1554 File.Before_LM := False; | |
1555 File.Before_LM_PM := False; | |
1556 end Reset; | |
1557 | |
1558 procedure Reset (File : in out File_Type) is | |
1559 begin | |
1560 Terminate_Line (File); | |
1561 FIO.Reset (AP (File)'Unrestricted_Access); | |
1562 File.Page := 1; | |
1563 File.Line := 1; | |
1564 File.Col := 1; | |
1565 File.Line_Length := 0; | |
1566 File.Page_Length := 0; | |
1567 File.Before_LM := False; | |
1568 File.Before_LM_PM := False; | |
1569 end Reset; | |
1570 | |
1571 ------------- | |
1572 -- Set_Col -- | |
1573 ------------- | |
1574 | |
1575 procedure Set_Col | |
1576 (File : File_Type; | |
1577 To : Positive_Count) | |
1578 is | |
1579 ch : int; | |
1580 | |
1581 begin | |
1582 -- Raise Constraint_Error if out of range value. The reason for this | |
1583 -- explicit test is that we don't want junk values around, even if | |
1584 -- checks are off in the caller. | |
1585 | |
1586 if not To'Valid then | |
1587 raise Constraint_Error; | |
1588 end if; | |
1589 | |
1590 FIO.Check_File_Open (AP (File)); | |
1591 | |
1592 -- Output case | |
1593 | |
1594 if Mode (File) >= Out_File then | |
1595 | |
1596 -- Error if we attempt to set Col to a value greater than the | |
1597 -- maximum permissible line length. | |
1598 | |
1599 if File.Line_Length /= 0 and then To > File.Line_Length then | |
1600 raise Layout_Error; | |
1601 end if; | |
1602 | |
1603 -- If we are behind current position, then go to start of new line | |
1604 | |
1605 if To < File.Col then | |
1606 New_Line (File); | |
1607 end if; | |
1608 | |
1609 -- Loop to output blanks till we are at the required column | |
1610 | |
1611 while File.Col < To loop | |
1612 Put (File, ' '); | |
1613 end loop; | |
1614 | |
1615 -- Input case | |
1616 | |
1617 else | |
1618 -- If we are logically before a LM, but physically after it, the | |
1619 -- file position still reflects the position before the LM, so eat | |
1620 -- it now and adjust the file position appropriately. | |
1621 | |
1622 if File.Before_LM then | |
1623 File.Before_LM := False; | |
1624 File.Before_LM_PM := False; | |
1625 File.Line := File.Line + 1; | |
1626 File.Col := 1; | |
1627 end if; | |
1628 | |
1629 -- Loop reading characters till we get one at the required Col value | |
1630 | |
1631 loop | |
1632 -- Read next character. The reason we have to read ahead is to | |
1633 -- skip formatting characters, the effect of Set_Col is to set | |
1634 -- us to a real character with the right Col value, and format | |
1635 -- characters don't count. | |
1636 | |
1637 ch := Getc (File); | |
1638 | |
1639 -- Error if we hit an end of file | |
1640 | |
1641 if ch = EOF then | |
1642 raise End_Error; | |
1643 | |
1644 -- If line mark, eat it and adjust file position | |
1645 | |
1646 elsif ch = LM then | |
1647 File.Line := File.Line + 1; | |
1648 File.Col := 1; | |
1649 | |
1650 -- If recognized page mark, eat it, and adjust file position | |
1651 | |
1652 elsif ch = PM and then File.Is_Regular_File then | |
1653 File.Page := File.Page + 1; | |
1654 File.Line := 1; | |
1655 File.Col := 1; | |
1656 | |
1657 -- Otherwise this is the character we are looking for, so put it | |
1658 -- back in the input stream (we have not adjusted the file | |
1659 -- position yet, so everything is set right after this ungetc). | |
1660 | |
1661 elsif To = File.Col then | |
1662 Ungetc (ch, File); | |
1663 return; | |
1664 | |
1665 -- Keep skipping characters if we are not there yet, updating the | |
1666 -- file position past the skipped character. | |
1667 | |
1668 else | |
1669 File.Col := File.Col + 1; | |
1670 end if; | |
1671 end loop; | |
1672 end if; | |
1673 end Set_Col; | |
1674 | |
1675 procedure Set_Col (To : Positive_Count) is | |
1676 begin | |
1677 Set_Col (Current_Out, To); | |
1678 end Set_Col; | |
1679 | |
1680 --------------- | |
1681 -- Set_Error -- | |
1682 --------------- | |
1683 | |
1684 procedure Set_Error (File : File_Type) is | |
1685 begin | |
1686 FIO.Check_Write_Status (AP (File)); | |
1687 Current_Err := File; | |
1688 end Set_Error; | |
1689 | |
1690 --------------- | |
1691 -- Set_Input -- | |
1692 --------------- | |
1693 | |
1694 procedure Set_Input (File : File_Type) is | |
1695 begin | |
1696 FIO.Check_Read_Status (AP (File)); | |
1697 Current_In := File; | |
1698 end Set_Input; | |
1699 | |
1700 -------------- | |
1701 -- Set_Line -- | |
1702 -------------- | |
1703 | |
1704 procedure Set_Line | |
1705 (File : File_Type; | |
1706 To : Positive_Count) | |
1707 is | |
1708 begin | |
1709 -- Raise Constraint_Error if out of range value. The reason for this | |
1710 -- explicit test is that we don't want junk values around, even if | |
1711 -- checks are off in the caller. | |
1712 | |
1713 if not To'Valid then | |
1714 raise Constraint_Error; | |
1715 end if; | |
1716 | |
1717 FIO.Check_File_Open (AP (File)); | |
1718 | |
1719 if To = File.Line then | |
1720 return; | |
1721 end if; | |
1722 | |
1723 if Mode (File) >= Out_File then | |
1724 if File.Page_Length /= 0 and then To > File.Page_Length then | |
1725 raise Layout_Error; | |
1726 end if; | |
1727 | |
1728 if To < File.Line then | |
1729 New_Page (File); | |
1730 end if; | |
1731 | |
1732 while File.Line < To loop | |
1733 New_Line (File); | |
1734 end loop; | |
1735 | |
1736 else | |
1737 while To /= File.Line loop | |
1738 Skip_Line (File); | |
1739 end loop; | |
1740 end if; | |
1741 end Set_Line; | |
1742 | |
1743 procedure Set_Line (To : Positive_Count) is | |
1744 begin | |
1745 Set_Line (Current_Out, To); | |
1746 end Set_Line; | |
1747 | |
1748 --------------------- | |
1749 -- Set_Line_Length -- | |
1750 --------------------- | |
1751 | |
1752 procedure Set_Line_Length (File : File_Type; To : Count) is | |
1753 begin | |
1754 -- Raise Constraint_Error if out of range value. The reason for this | |
1755 -- explicit test is that we don't want junk values around, even if | |
1756 -- checks are off in the caller. | |
1757 | |
1758 if not To'Valid then | |
1759 raise Constraint_Error; | |
1760 end if; | |
1761 | |
1762 FIO.Check_Write_Status (AP (File)); | |
1763 File.Line_Length := To; | |
1764 end Set_Line_Length; | |
1765 | |
1766 procedure Set_Line_Length (To : Count) is | |
1767 begin | |
1768 Set_Line_Length (Current_Out, To); | |
1769 end Set_Line_Length; | |
1770 | |
1771 ---------------- | |
1772 -- Set_Output -- | |
1773 ---------------- | |
1774 | |
1775 procedure Set_Output (File : File_Type) is | |
1776 begin | |
1777 FIO.Check_Write_Status (AP (File)); | |
1778 Current_Out := File; | |
1779 end Set_Output; | |
1780 | |
1781 --------------------- | |
1782 -- Set_Page_Length -- | |
1783 --------------------- | |
1784 | |
1785 procedure Set_Page_Length (File : File_Type; To : Count) is | |
1786 begin | |
1787 -- Raise Constraint_Error if out of range value. The reason for this | |
1788 -- explicit test is that we don't want junk values around, even if | |
1789 -- checks are off in the caller. | |
1790 | |
1791 if not To'Valid then | |
1792 raise Constraint_Error; | |
1793 end if; | |
1794 | |
1795 FIO.Check_Write_Status (AP (File)); | |
1796 File.Page_Length := To; | |
1797 end Set_Page_Length; | |
1798 | |
1799 procedure Set_Page_Length (To : Count) is | |
1800 begin | |
1801 Set_Page_Length (Current_Out, To); | |
1802 end Set_Page_Length; | |
1803 | |
1804 -------------- | |
1805 -- Set_WCEM -- | |
1806 -------------- | |
1807 | |
1808 procedure Set_WCEM (File : in out File_Type) is | |
1809 Start : Natural; | |
1810 Stop : Natural; | |
1811 | |
1812 begin | |
1813 FIO.Form_Parameter (File.Form.all, "wcem", Start, Stop); | |
1814 | |
1815 if Start = 0 then | |
1816 File.WC_Method := Default_WCEM; | |
1817 | |
1818 else | |
1819 if Stop = Start then | |
1820 for J in WC_Encoding_Letters'Range loop | |
1821 if File.Form (Start) = WC_Encoding_Letters (J) then | |
1822 File.WC_Method := J; | |
1823 return; | |
1824 end if; | |
1825 end loop; | |
1826 end if; | |
1827 | |
1828 Close (File); | |
1829 raise Use_Error with "invalid WCEM form parameter"; | |
1830 end if; | |
1831 end Set_WCEM; | |
1832 | |
1833 --------------- | |
1834 -- Skip_Line -- | |
1835 --------------- | |
1836 | |
1837 procedure Skip_Line | |
1838 (File : File_Type; | |
1839 Spacing : Positive_Count := 1) | |
1840 is | |
1841 ch : int; | |
1842 | |
1843 begin | |
1844 -- Raise Constraint_Error if out of range value. The reason for this | |
1845 -- explicit test is that we don't want junk values around, even if | |
1846 -- checks are off in the caller. | |
1847 | |
1848 if not Spacing'Valid then | |
1849 raise Constraint_Error; | |
1850 end if; | |
1851 | |
1852 FIO.Check_Read_Status (AP (File)); | |
1853 | |
1854 for L in 1 .. Spacing loop | |
1855 if File.Before_LM then | |
1856 File.Before_LM := False; | |
1857 | |
1858 -- Note that if File.Before_LM_PM is currently set, we also have | |
1859 -- to reset it (because it makes sense for Before_LM_PM to be set | |
1860 -- only when Before_LM is also set). This is done later on in this | |
1861 -- subprogram, as soon as Before_LM_PM has been taken into account | |
1862 -- for the purpose of page and line counts. | |
1863 | |
1864 else | |
1865 ch := Getc (File); | |
1866 | |
1867 -- If at end of file now, then immediately raise End_Error. Note | |
1868 -- that we can never be positioned between a line mark and a page | |
1869 -- mark, so if we are at the end of file, we cannot logically be | |
1870 -- before the implicit page mark that is at the end of the file. | |
1871 | |
1872 -- For the same reason, we do not need an explicit check for a | |
1873 -- page mark. If there is a FF in the middle of a line, the file | |
1874 -- is not in canonical format and we do not care about the page | |
1875 -- numbers for files other than ones in canonical format. | |
1876 | |
1877 if ch = EOF then | |
1878 raise End_Error; | |
1879 end if; | |
1880 | |
1881 -- If not at end of file, then loop till we get to an LM or EOF. | |
1882 -- The latter case happens only in non-canonical files where the | |
1883 -- last line is not terminated by LM, but we don't want to blow | |
1884 -- up for such files, so we assume an implicit LM in this case. | |
1885 | |
1886 loop | |
1887 exit when ch = LM or else ch = EOF; | |
1888 ch := Getc (File); | |
1889 end loop; | |
1890 end if; | |
1891 | |
1892 -- We have got past a line mark, now, for a regular file only, | |
1893 -- see if a page mark immediately follows this line mark and | |
1894 -- if so, skip past the page mark as well. We do not do this | |
1895 -- for non-regular files, since it would cause an undesirable | |
1896 -- wait for an additional character. | |
1897 | |
1898 File.Col := 1; | |
1899 File.Line := File.Line + 1; | |
1900 | |
1901 if File.Before_LM_PM then | |
1902 File.Page := File.Page + 1; | |
1903 File.Line := 1; | |
1904 File.Before_LM_PM := False; | |
1905 | |
1906 elsif File.Is_Regular_File then | |
1907 ch := Getc (File); | |
1908 | |
1909 -- Page mark can be explicit, or implied at the end of the file | |
1910 | |
1911 if (ch = PM or else ch = EOF) | |
1912 and then File.Is_Regular_File | |
1913 then | |
1914 File.Page := File.Page + 1; | |
1915 File.Line := 1; | |
1916 else | |
1917 Ungetc (ch, File); | |
1918 end if; | |
1919 end if; | |
1920 end loop; | |
1921 | |
1922 File.Before_Upper_Half_Character := False; | |
1923 end Skip_Line; | |
1924 | |
1925 procedure Skip_Line (Spacing : Positive_Count := 1) is | |
1926 begin | |
1927 Skip_Line (Current_In, Spacing); | |
1928 end Skip_Line; | |
1929 | |
1930 --------------- | |
1931 -- Skip_Page -- | |
1932 --------------- | |
1933 | |
1934 procedure Skip_Page (File : File_Type) is | |
1935 ch : int; | |
1936 | |
1937 begin | |
1938 FIO.Check_Read_Status (AP (File)); | |
1939 | |
1940 -- If at page mark already, just skip it | |
1941 | |
1942 if File.Before_LM_PM then | |
1943 File.Before_LM := False; | |
1944 File.Before_LM_PM := False; | |
1945 File.Page := File.Page + 1; | |
1946 File.Line := 1; | |
1947 File.Col := 1; | |
1948 return; | |
1949 end if; | |
1950 | |
1951 -- This is a bit tricky, if we are logically before an LM then | |
1952 -- it is not an error if we are at an end of file now, since we | |
1953 -- are not really at it. | |
1954 | |
1955 if File.Before_LM then | |
1956 File.Before_LM := False; | |
1957 File.Before_LM_PM := False; | |
1958 ch := Getc (File); | |
1959 | |
1960 -- Otherwise we do raise End_Error if we are at the end of file now | |
1961 | |
1962 else | |
1963 ch := Getc (File); | |
1964 | |
1965 if ch = EOF then | |
1966 raise End_Error; | |
1967 end if; | |
1968 end if; | |
1969 | |
1970 -- Now we can just rumble along to the next page mark, or to the | |
1971 -- end of file, if that comes first. The latter case happens when | |
1972 -- the page mark is implied at the end of file. | |
1973 | |
1974 loop | |
1975 exit when ch = EOF | |
1976 or else (ch = PM and then File.Is_Regular_File); | |
1977 ch := Getc (File); | |
1978 end loop; | |
1979 | |
1980 File.Page := File.Page + 1; | |
1981 File.Line := 1; | |
1982 File.Col := 1; | |
1983 File.Before_Upper_Half_Character := False; | |
1984 end Skip_Page; | |
1985 | |
1986 procedure Skip_Page is | |
1987 begin | |
1988 Skip_Page (Current_In); | |
1989 end Skip_Page; | |
1990 | |
1991 -------------------- | |
1992 -- Standard_Error -- | |
1993 -------------------- | |
1994 | |
1995 function Standard_Error return File_Type is | |
1996 begin | |
1997 return Standard_Err; | |
1998 end Standard_Error; | |
1999 | |
2000 function Standard_Error return File_Access is | |
2001 begin | |
2002 return Standard_Err'Access; | |
2003 end Standard_Error; | |
2004 | |
2005 -------------------- | |
2006 -- Standard_Input -- | |
2007 -------------------- | |
2008 | |
2009 function Standard_Input return File_Type is | |
2010 begin | |
2011 return Standard_In; | |
2012 end Standard_Input; | |
2013 | |
2014 function Standard_Input return File_Access is | |
2015 begin | |
2016 return Standard_In'Access; | |
2017 end Standard_Input; | |
2018 | |
2019 --------------------- | |
2020 -- Standard_Output -- | |
2021 --------------------- | |
2022 | |
2023 function Standard_Output return File_Type is | |
2024 begin | |
2025 return Standard_Out; | |
2026 end Standard_Output; | |
2027 | |
2028 function Standard_Output return File_Access is | |
2029 begin | |
2030 return Standard_Out'Access; | |
2031 end Standard_Output; | |
2032 | |
2033 -------------------- | |
2034 -- Terminate_Line -- | |
2035 -------------------- | |
2036 | |
2037 procedure Terminate_Line (File : File_Type) is | |
2038 begin | |
2039 FIO.Check_File_Open (AP (File)); | |
2040 | |
2041 -- For file other than In_File, test for needing to terminate last line | |
2042 | |
2043 if Mode (File) /= In_File then | |
2044 | |
2045 -- If not at start of line definition need new line | |
2046 | |
2047 if File.Col /= 1 then | |
2048 New_Line (File); | |
2049 | |
2050 -- For files other than standard error and standard output, we | |
2051 -- make sure that an empty file has a single line feed, so that | |
2052 -- it is properly formatted. We avoid this for the standard files | |
2053 -- because it is too much of a nuisance to have these odd line | |
2054 -- feeds when nothing has been written to the file. | |
2055 | |
2056 -- We also avoid this for files opened in append mode, in | |
2057 -- accordance with (RM A.8.2(10)) | |
2058 | |
2059 elsif (File /= Standard_Err and then File /= Standard_Out) | |
2060 and then (File.Line = 1 and then File.Page = 1) | |
2061 and then Mode (File) = Out_File | |
2062 then | |
2063 New_Line (File); | |
2064 end if; | |
2065 end if; | |
2066 end Terminate_Line; | |
2067 | |
2068 ------------ | |
2069 -- Ungetc -- | |
2070 ------------ | |
2071 | |
2072 procedure Ungetc (ch : int; File : File_Type) is | |
2073 begin | |
2074 if ch /= EOF then | |
2075 if ungetc (ch, File.Stream) = EOF then | |
2076 raise Device_Error; | |
2077 end if; | |
2078 end if; | |
2079 end Ungetc; | |
2080 | |
2081 ----------- | |
2082 -- Write -- | |
2083 ----------- | |
2084 | |
2085 -- This is the primitive Stream Write routine, used when a Text_IO file | |
2086 -- is treated directly as a stream using Text_IO.Streams.Stream. | |
2087 | |
2088 procedure Write | |
2089 (File : in out Text_AFCB; | |
2090 Item : Stream_Element_Array) | |
2091 is | |
2092 pragma Warnings (Off, File); | |
2093 -- Because in this implementation we don't need IN OUT, we only read | |
2094 | |
2095 function Has_Translated_Characters return Boolean; | |
2096 -- return True if Item array contains a character which will be | |
2097 -- translated under the text file mode. There is only one such | |
2098 -- character under DOS based systems which is character 10. | |
2099 | |
2100 text_translation_required : Boolean; | |
2101 for text_translation_required'Size use Character'Size; | |
2102 pragma Import (C, text_translation_required, | |
2103 "__gnat_text_translation_required"); | |
2104 | |
2105 Siz : constant size_t := Item'Length; | |
2106 | |
2107 ------------------------------- | |
2108 -- Has_Translated_Characters -- | |
2109 ------------------------------- | |
2110 | |
2111 function Has_Translated_Characters return Boolean is | |
2112 begin | |
2113 for K in Item'Range loop | |
2114 if Item (K) = 10 then | |
2115 return True; | |
2116 end if; | |
2117 end loop; | |
2118 return False; | |
2119 end Has_Translated_Characters; | |
2120 | |
2121 Needs_Binary_Write : constant Boolean := | |
2122 text_translation_required and then Has_Translated_Characters; | |
2123 | |
2124 -- Start of processing for Write | |
2125 | |
2126 begin | |
2127 if File.Mode = FCB.In_File then | |
2128 raise Mode_Error; | |
2129 end if; | |
2130 | |
2131 -- Now we do the write. Since this is a text file, it is normally in | |
2132 -- text mode, but stream data must be written in binary mode, so we | |
2133 -- temporarily set binary mode for the write, resetting it after. This | |
2134 -- is done only if needed (i.e. there is some characters in Item which | |
2135 -- needs to be written using the binary mode). | |
2136 -- These calls have no effect in a system (like Unix) where there is | |
2137 -- no distinction between text and binary files. | |
2138 | |
2139 -- Since the character translation is done at the time the buffer is | |
2140 -- written (this is true under Windows) we first flush current buffer | |
2141 -- with text mode if needed. | |
2142 | |
2143 if Needs_Binary_Write then | |
2144 if fflush (File.Stream) = -1 then | |
2145 raise Device_Error; | |
2146 end if; | |
2147 | |
2148 set_binary_mode (fileno (File.Stream)); | |
2149 end if; | |
2150 | |
2151 if fwrite (Item'Address, 1, Siz, File.Stream) /= Siz then | |
2152 raise Device_Error; | |
2153 end if; | |
2154 | |
2155 -- At this point we need to flush the buffer using the binary mode then | |
2156 -- we reset to text mode. | |
2157 | |
2158 if Needs_Binary_Write then | |
2159 if fflush (File.Stream) = -1 then | |
2160 raise Device_Error; | |
2161 end if; | |
2162 | |
2163 set_text_mode (fileno (File.Stream)); | |
2164 end if; | |
2165 end Write; | |
2166 | |
2167 begin | |
2168 -- Initialize Standard Files | |
2169 | |
2170 for J in WC_Encoding_Method loop | |
2171 if WC_Encoding = WC_Encoding_Letters (J) then | |
2172 Default_WCEM := J; | |
2173 end if; | |
2174 end loop; | |
2175 | |
2176 Initialize_Standard_Files; | |
2177 | |
2178 FIO.Chain_File (AP (Standard_In)); | |
2179 FIO.Chain_File (AP (Standard_Out)); | |
2180 FIO.Chain_File (AP (Standard_Err)); | |
2181 | |
2182 end Ada.Text_IO; |