home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / gnat-2.06-src.tgz / tar.out / fsf / gnat / ada / s-sequio.adb < prev    next >
Text File  |  1996-09-28  |  5KB  |  153 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                         GNAT RUNTIME COMPONENTS                          --
  4. --                                                                          --
  5. --                 S Y S T E M . S E Q U E N T I A L _ I O                  --
  6. --                                                                          --
  7. --                                 B o d y                                  --
  8. --                                                                          --
  9. --                            $Revision: 1.4 $                              --
  10. --                                                                          --
  11. --           Copyright (c) 1992,1993,1994 NYU, All Rights Reserved          --
  12. --                                                                          --
  13. -- The GNAT library is free software; you can redistribute it and/or modify --
  14. -- it under terms of the GNU Library General Public License as published by --
  15. -- the Free Software  Foundation; either version 2, or (at your option) any --
  16. -- later version.  The GNAT library is distributed in the hope that it will --
  17. -- be useful, but WITHOUT ANY WARRANTY;  without even  the implied warranty --
  18. -- of MERCHANTABILITY  or  FITNESS FOR  A PARTICULAR PURPOSE.  See the  GNU --
  19. -- Library  General  Public  License for  more  details.  You  should  have --
  20. -- received  a copy of the GNU  Library  General Public License  along with --
  21. -- the GNAT library;  see the file  COPYING.LIB.  If not, write to the Free --
  22. -- Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.        --
  23. --                                                                          --
  24. ------------------------------------------------------------------------------
  25.  
  26. with Ada.IO_Exceptions;         use Ada.IO_Exceptions;
  27. with System;                    use System;
  28. with System.File_IO;
  29. with Unchecked_Deallocation;
  30.  
  31. package body System.Sequential_IO is
  32.  
  33.    subtype AP is FCB.AFCB_Ptr;
  34.  
  35.    package FIO renames System.File_IO;
  36.  
  37.    -------------------
  38.    -- AFCB_Allocate --
  39.    -------------------
  40.  
  41.    function AFCB_Allocate
  42.      (Control_Block : Sequential_AFCB)
  43.       return          FCB.AFCB_Ptr
  44.    is
  45.    begin
  46.       return new Sequential_AFCB;
  47.    end AFCB_Allocate;
  48.  
  49.    ----------------
  50.    -- AFCB_Close --
  51.    ----------------
  52.  
  53.    --  No special processing required for Sequential_IO close
  54.  
  55.    procedure AFCB_Close (File : access Sequential_AFCB) is
  56.    begin
  57.       null;
  58.    end AFCB_Close;
  59.  
  60.    ---------------
  61.    -- AFCB_Free --
  62.    ---------------
  63.  
  64.    procedure AFCB_Free (File : access Sequential_AFCB) is
  65.  
  66.       type FCB_Ptr is access all Sequential_AFCB;
  67.  
  68.       FT : FCB_Ptr := File;
  69.  
  70.       procedure Free is new
  71.         Unchecked_Deallocation (Sequential_AFCB, FCB_Ptr);
  72.  
  73.    begin
  74.       Free (FT);
  75.    end AFCB_Free;
  76.  
  77.    ------------
  78.    -- Create --
  79.    ------------
  80.  
  81.    procedure Create
  82.      (File : in out File_Type;
  83.       Mode : in FCB.File_Mode := FCB.Out_File;
  84.       Name : in String := "";
  85.       Form : in String := "")
  86.    is
  87.       File_Control_Block : Sequential_AFCB;
  88.  
  89.    begin
  90.       FIO.Open (File_Ptr  => AP (File),
  91.                 Dummy_FCB => File_Control_Block,
  92.                 Mode     => Mode,
  93.                 Name     => Name,
  94.                 Form     => Form,
  95.                 Amethod  => 'Q',
  96.                 Creat    => True,
  97.                 Text     => False);
  98.    end Create;
  99.  
  100.    ----------
  101.    -- Open --
  102.    ----------
  103.  
  104.    procedure Open
  105.      (File : in out File_Type;
  106.       Mode : in FCB.File_Mode;
  107.       Name : in String;
  108.       Form : in String := "")
  109.    is
  110.       File_Control_Block : Sequential_AFCB;
  111.  
  112.    begin
  113.       FIO.Open (File_Ptr  => AP (File),
  114.                 Dummy_FCB => File_Control_Block,
  115.                 Mode      => Mode,
  116.                 Name      => Name,
  117.                 Form      => Form,
  118.                 Amethod   => 'Q',
  119.                 Creat     => False,
  120.                 Text      => False);
  121.    end Open;
  122.  
  123.    ----------
  124.    -- Read --
  125.    ----------
  126.  
  127.    --  Not used, since Sequential_IO files are not used as streams
  128.  
  129.    procedure Read
  130.      (File : in out Sequential_AFCB;
  131.       Item : out Ada.Streams.Stream_Element_Array;
  132.       Last : out Ada.Streams.Stream_Element_Offset)
  133.    is
  134.    begin
  135.       raise Program_Error;
  136.    end Read;
  137.  
  138.    -----------
  139.    -- Write --
  140.    -----------
  141.  
  142.    --  Not used, since Sequential_IO files are not used as streams
  143.  
  144.    procedure Write
  145.      (File : in out Sequential_AFCB;
  146.       Item : in Ada.Streams.Stream_Element_Array)
  147.    is
  148.    begin
  149.       raise Program_Error;
  150.    end Write;
  151.  
  152. end System.Sequential_IO;
  153.