|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 12288 (0x3000) Types: Ada Source Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Direct_Io, seg_04ba61
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000 └─⟦5a81ac88f⟧ »Space Info Vol 1« └─⟦this⟧
with File_Support; use File_Support; with Safe_Support; with System; with A_Strings; with Memory; with Unchecked_Conversion; pragma Elaborate (File_Support); package body Direct_Io is pragma Suppress (Access_Check); pragma Suppress (Discriminant_Check); pragma Suppress (Index_Check); pragma Suppress (Length_Check); pragma Suppress (Range_Check); pragma Suppress (Division_Check); pragma Suppress (Elaboration_Check); Elem_Size : Integer; Bits_Per_Byte : constant := 8; function Mode_Of (Mode : File_Mode) return File_Support.File_Mode is begin case Mode is when In_File => return Input; when Out_File => return Output; when Inout_File => return In_Out; end case; end Mode_Of; procedure Reject_Null_File (File : File_Type) is begin if File = null then raise Status_Error; end if; end Reject_Null_File; -- pragma inline(reject_null_file); -- file management -- No file locking. file can't be referenced until create() returns. procedure Create (File : in out File_Type; Mode : in File_Mode := Inout_File; Name : in String := ""; Form : in String := "") is Fmode : File_Support.File_Mode := Mode_Of (Mode); begin --Stanford\x09\x09if elem_size > system.MAX_REC_SIZE then --Stanford\x09\x09\x09raise use_error; --Stanford\x09\x09end if; -- Upon entry/exit: file is unlocked for the following two calls File_Open (Name, File_Ptr (File), Fmode, True, Form, Direct, Elem_Size); File_Support.Setup_Buffer (File_Ptr (File), Elem_Size); end Create; -- No file locking. file can't be referenced until open() returns. procedure Open (File : in out File_Type; Mode : in File_Mode; Name : in String; Form : in String := "") is Fmode : File_Support.File_Mode := Mode_Of (Mode); begin --Stanford\x09\x09if elem_size > system.MAX_REC_SIZE then --Stanford\x09\x09\x09raise use_error; --Stanford\x09\x09end if; -- Upon entry/exit: file is unlocked for the following two calls File_Open (Name, File_Ptr (File), Fmode, False, Form, Direct, Elem_Size); File_Support.Setup_Buffer (File_Ptr (File), Elem_Size); end Open; procedure Close (File : in out File_Type) is begin Reject_Null_File (File); Safe_Support.File_Lock (File_Ptr (File)); File_Close (File_Ptr (File)); -- upon return, file is unlocked File := null; end Close; procedure Delete (File : in out File_Type) is begin Reject_Null_File (File); Safe_Support.File_Lock (File_Ptr (File)); File_Delete (File_Ptr (File)); -- upon return, file is unlocked File := null; end Delete; procedure Reset (File : in out File_Type; Mode : in File_Mode) is Fmode : File_Support.File_Mode := Mode_Of (Mode); begin Safe_Support.File_Lock (File_Ptr (File)); Reject_Null_File (File); File_Reset (File_Ptr (File), Fmode); Safe_Support.File_Unlock (File_Ptr (File)); exception when others => Safe_Support.File_Unlock (File_Ptr (File)); raise; end Reset; procedure Reset (File : in out File_Type) is begin Safe_Support.File_Lock (File_Ptr (File)); Reject_Null_File (File); File_Reset (File_Ptr (File), File.Mode); Safe_Support.File_Unlock (File_Ptr (File)); exception when others => Safe_Support.File_Unlock (File_Ptr (File)); raise; end Reset; function Mode (File : in File_Type) return File_Mode is begin Reject_Null_File (File); case File.Mode is when Input => return In_File; when Output => return Out_File; when In_Out => return Inout_File; end case; end Mode; function Name (File : in File_Type) return String is use A_Strings; begin Reject_Null_File (File); if File.Name = null then return ""; else return File.Name.S; end if; end Name; function Form (File : in File_Type) return String is use A_Strings; begin Reject_Null_File (File); if File.Form = null then return ""; end if; return File.Form.S; end Form; function Is_Open (File : in File_Type) return Boolean is begin return File /= null; end Is_Open; -- input and output operations -- Upon entry/exit: file is locked -- -- This routine is called by the overloaded read() routines procedure Do_Read (File : in File_Type; Item : out Element_Type; From : in Positive_Count) is Actual : Integer; begin Reject_Null_File (File); if File.Mode = Output then raise Mode_Error; end if; Position_File (File.Fd, Integer (From), Elem_Size); Actual := Read (File.Fd, Item'Long_Address, Item'Size / Bits_Per_Byte); if Actual /= Item'Size / Bits_Per_Byte then File.Pagelength := Actual; raise End_Error; end if; File.Index := Natural (From + 1); end Do_Read; procedure Read (File : in File_Type; Item : out Element_Type; From : in Positive_Count) is begin Safe_Support.File_Lock (File_Ptr (File)); Do_Read (File, Item, From); Safe_Support.File_Unlock (File_Ptr (File)); exception when others => Safe_Support.File_Unlock (File_Ptr (File)); raise; end Read; procedure Read (File : in File_Type; Item : out Element_Type) is begin Safe_Support.File_Lock (File_Ptr (File)); Reject_Null_File (File); Do_Read (File, Item, Positive_Count (File.Index)); Safe_Support.File_Unlock (File_Ptr (File)); exception when others => Safe_Support.File_Unlock (File_Ptr (File)); raise; end Read; procedure Copy (From, To : System.Long_Address; Bytes : Integer) is type Buffer is array (1 .. Bytes) of Character; type Acc_Buf is access Buffer; pragma Remote_Access (Acc_Buf); function To_Acc is new Unchecked_Conversion (System.Long_Address, Acc_Buf); begin To_Acc (To).all := To_Acc (From).all; end Copy; -- Upon entry/exit: file is locked -- -- This routine is called by the overloaded write() routines procedure Do_Write (File : in File_Type; Item : in Element_Type; To : in Positive_Count) is This_Elem_Size : Integer := Item'Size / Bits_Per_Byte; Item_Addr : System.Long_Address; begin Reject_Null_File (File); if File.Mode = Input then raise Mode_Error; end if; Position_File (File.Fd, Integer (To), Elem_Size); if This_Elem_Size < Elem_Size then -- copy item into buffer, to fill out waste space. Item_Addr := File.Buffer.Elem'Long_Address; Copy (Item'Long_Address, Item_Addr, This_Elem_Size); elsif This_Elem_Size = Elem_Size then Item_Addr := Item'Long_Address; else raise Device_Error; -- must be greater than MAX_REC_SIZE end if; Write (File.Fd, Item_Addr, Elem_Size); File.Index := Natural (To + 1); end Do_Write; procedure Write (File : in File_Type; Item : in Element_Type; To : in Positive_Count) is begin Safe_Support.File_Lock (File_Ptr (File)); Do_Write (File, Item, To); Safe_Support.File_Unlock (File_Ptr (File)); exception when others => Safe_Support.File_Unlock (File_Ptr (File)); raise; end Write; procedure Write (File : in File_Type; Item : in Element_Type) is begin Safe_Support.File_Lock (File_Ptr (File)); Reject_Null_File (File); Do_Write (File, Item, Positive_Count (File.Index)); Safe_Support.File_Unlock (File_Ptr (File)); exception when others => Safe_Support.File_Unlock (File_Ptr (File)); raise; end Write; procedure Set_Index (File : in File_Type; To : in Positive_Count) is begin Safe_Support.File_Lock (File_Ptr (File)); Reject_Null_File (File); Position_File (File.Fd, Integer (To), Elem_Size); File.Index := Natural (To); Safe_Support.File_Unlock (File_Ptr (File)); exception when others => Safe_Support.File_Unlock (File_Ptr (File)); raise; end Set_Index; function Index (File : in File_Type) return Positive_Count is begin Reject_Null_File (File); return Positive_Count (File.Index); end Index; function Size (File : in File_Type) return Count is Cnt : Count; begin Safe_Support.File_Lock (File_Ptr (File)); Reject_Null_File (File); Cnt := Count (File_Size (File.Fd, Elem_Size)); Safe_Support.File_Unlock (File_Ptr (File)); return Cnt; exception when others => Safe_Support.File_Unlock (File_Ptr (File)); raise; end Size; function End_Of_File (File : in File_Type) return Boolean is Result : Boolean; begin Safe_Support.File_Lock (File_Ptr (File)); Reject_Null_File (File); if File.Mode = Output then raise Mode_Error; end if; Result := File_Eof (File_Ptr (File)); Safe_Support.File_Unlock (File_Ptr (File)); return Result; exception when others => Safe_Support.File_Unlock (File_Ptr (File)); raise; end End_Of_File; begin Elem_Size := Element_Type'Size / Bits_Per_Byte; --Stanford\x09if not element_type'constrained then --Stanford\x09\x09if elem_size > system.max_rec_size or else elem_size <= 0 then --Stanford\x09\x09\x09elem_size := system.max_rec_size; --Stanford\x09\x09end if; --Stanford\x09end if; exception when Numeric_Error | Constraint_Error => Elem_Size := System.Max_Rec_Size; end Direct_Io;
nblk1=b nid=0 hdr6=16 [0x00] rec0=28 rec1=00 rec2=01 rec3=01e [0x01] rec0=19 rec1=00 rec2=02 rec3=012 [0x02] rec0=19 rec1=00 rec2=03 rec3=08e [0x03] rec0=1f rec1=00 rec2=04 rec3=03e [0x04] rec0=29 rec1=00 rec2=05 rec3=002 [0x05] rec0=19 rec1=00 rec2=06 rec3=056 [0x06] rec0=1d rec1=00 rec2=07 rec3=036 [0x07] rec0=17 rec1=00 rec2=08 rec3=054 [0x08] rec0=1e rec1=00 rec2=09 rec3=010 [0x09] rec0=1f rec1=00 rec2=0a rec3=000 [0x0a] rec0=1d rec1=00 rec2=0b rec3=000 tail 0x21548d50086843b8e7229 0x42a00088462060003