|
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 - download
Length: 17408 (0x4400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Event, package body Ihm, package body Window, package body Xt, seg_0265c5, seg_026eac, seg_02750a, seg_027e6c
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with System;
with Text_Io;
package body Ihm is
procedure Init_C;
pragma Interface (C, Init_C);
pragma Interface_Information (Init_C, ".InitFrame");
procedure Action_C (Fid : Integer;
Fctn : System.Address;
Field : System.Address;
Value : System.Address);
pragma Interface (C, Action_C);
pragma Interface_Information (Action_C, ".Action");
procedure Action (Wid : Window_Id;
Fctn : String;
Field : String;
Value : String) is
C_Fctn : constant String := Fctn & Ascii.Nul;
C_Field : constant String := Field & Ascii.Nul;
C_Value : constant String := Value & Ascii.Nul;
begin
Action_C (Wid, C_Fctn (C_Fctn'First)'Address,
C_Field (C_Field'First)'Address,
C_Value (C_Value'First)'Address);
end Action;
function String_Length_C (Ptr : System.Address) return Integer;
pragma Interface (C, String_Length_C);
pragma Interface_Information (String_Length_C, ".strlen");
function String_C_To_Ada (S : System.Address) return String is
Str : String (1 .. String_Length_C (S));
for Str use at S;
--Ptr : array (1 .. String_Length_C (S)) of Character;
--for Ptr use at S;
--Str : String (1 .. String_Length_C (S));
begin
--for I in Str'Range loop
-- Str (I) := Ptr (I);
--end loop;
return Str;
end String_C_To_Ada;
package body Window is
function Get_Id_C (Window_Name : System.Address) return Integer;
pragma Interface (C, Get_Id_C);
pragma Interface_Information (Get_Id_C, ".GetFrameId");
function Get_Name_C (Local_Frame : Integer) return System.Address;
pragma Interface (C, Get_Name_C);
pragma Interface_Information (Get_Name_C, ".GetFrameName");
function Nb_Wid_C return Integer;
pragma Interface (C, Nb_Wid_C);
pragma Interface_Information (Nb_Wid_C, ".MaxFrame");
procedure Put_Event_C (Fid : Integer;
Fctn : System.Address;
Field : System.Address;
Value : System.Address);
pragma Interface (C, Put_Event_C);
pragma Interface_Information (Put_Event_C, ".PutEventAda");
------------------------------------------------------------
function Name (Wid : Window_Id) return String is
begin
return String_C_To_Ada (Get_Name_C (Wid));
end Name;
function Nb_Wid return Window_Id is
begin
return Nb_Wid_C;
end Nb_Wid;
function Open (Name : String) return Window_Id is
C_Message : constant String := Name & Ascii.Nul;
Wid : Window_Id;
begin
Wid := Get_Id_C (C_Message (C_Message'First)'Address);
Action (Wid, "OpenWindow", Name, "");
return Wid;
end Open;
procedure Close (Wid : Window_Id) is
begin
Action (Wid, "CloseWindow", "", "");
end Close;
procedure Put_Field (Wid : Window_Id; Field : String; Value : String) is
C_Fctn : constant String := "PutField" & Ascii.Nul;
C_Field : constant String := Field & Ascii.Nul;
C_Value : constant String := Value & Ascii.Nul;
begin
Put_Event_C (Wid, C_Fctn (C_Fctn'First)'Address,
C_Field (C_Field'First)'Address,
C_Value (C_Value'First)'Address);
end Put_Field;
procedure Display_Field
(Wid : Window_Id; Field : String; Value : String) is
begin
Action (Wid, "PutField", Field, Value);
end Display_Field;
end Window;
package body Event is
function Empty_C (Wid : Integer) return Integer;
pragma Interface (C, Empty_C);
pragma Interface_Information (Empty_C, ".Empty");
function Get_Type_C (Wid : Integer) return System.Address;
pragma Interface (C, Get_Type_C);
pragma Interface_Information (Get_Type_C, ".GetType");
function Get_Field_C (Wid : Integer) return System.Address;
pragma Interface (C, Get_Field_C);
pragma Interface_Information (Get_Field_C, ".GetField");
function Get_Value_C (Fid : Integer) return System.Address;
pragma Interface (C, Get_Value_C);
pragma Interface_Information (Get_Value_C, ".GetValue");
procedure Next_C (Wid : Integer);
pragma Interface (C, Next_C);
pragma Interface_Information (Next_C, ".Next");
function Get_Event (Wid : Window_Id) return Kind is
Event_String : constant String :=
String_C_To_Ada (Get_Type_C (Wid));
begin
if Event_String = "PushButton" then
return Pushbutton;
elsif Event_String = "FieldEnter" then
return Fieldenter;
elsif Event_String = "PutField" then
return Putfield;
end if;
return Unknown;
end Get_Event;
function Get_Field (Wid : Window_Id) return String is
begin
return String_C_To_Ada (Get_Field_C (Wid));
end Get_Field;
function Get_Value (Wid : Window_Id) return String is
begin
return String_C_To_Ada (Get_Value_C (Wid));
end Get_Value;
procedure Next (Wid : Window_Id) is
begin
Next_C (Wid);
end Next;
function Empty (Wid : Window_Id) return Boolean is
begin
if Empty_C (Wid) = 1 then
return True;
else
return False;
end if;
end Empty;
end Event;
package body Xt is
procedure Process_Event_C;
pragma Interface (C, Process_Event_C);
pragma Interface_Information (Process_Event_C, ".ProcessEvent");
procedure Process_Event is
begin
Process_Event_C;
end Process_Event;
end Xt;
begin
Init_C;
end Ihm;
nblk1=10
nid=5
hdr6=10
[0x00] rec0=1f rec1=00 rec2=01 rec3=018
[0x01] rec0=18 rec1=00 rec2=0e rec3=006
[0x02] rec0=19 rec1=00 rec2=0d rec3=01c
[0x03] rec0=1a rec1=00 rec2=0c rec3=036
[0x04] rec0=1b rec1=00 rec2=04 rec3=02c
[0x05] rec0=05 rec1=00 rec2=07 rec3=028
[0x06] rec0=1f rec1=00 rec2=0a rec3=01e
[0x07] rec0=19 rec1=00 rec2=10 rec3=000
[0x08] rec0=24 rec1=00 rec2=10 rec3=002
[0x09] rec0=1a rec1=00 rec2=05 rec3=000
[0x0a] rec0=1a rec1=00 rec2=05 rec3=000
[0x0b] rec0=04 rec1=00 rec2=04 rec3=000
[0x0c] rec0=24 rec1=00 rec2=09 rec3=3ff
[0x0d] rec0=00 rec1=00 rec2=00 rec3=002
[0x0e] rec0=00 rec1=00 rec2=00 rec3=0d9
[0x0f] rec0=00 rec1=00 rec2=00 rec3=000
tail 0x21721058883aa6e4e4ed0 0x42a00088462060003
Free Block Chain:
0x5: 0000 00 06 02 20 80 21 20 20 20 20 20 20 20 70 72 6f ┆ ! pro┆
0x6: 0000 00 09 00 07 80 04 20 20 20 20 04 74 75 72 6e 20 ┆ turn ┆
0x9: 0000 00 0b 00 49 80 07 79 70 65 5f 43 29 3b 07 00 3c ┆ I ype_C); <┆
0xb: 0000 00 08 00 4e 80 15 61 63 6b 61 67 65 20 62 6f 64 ┆ N ackage bod┆
0x8: 0000 00 03 00 09 00 06 20 20 20 20 20 20 06 53 79 73 ┆ Sys┆
0x3: 0000 00 02 03 fc 80 25 20 20 20 20 70 72 61 67 6d 61 ┆ % pragma┆
0x2: 0000 00 0f 00 33 80 29 6c 5f 46 72 61 6d 65 20 3a 20 ┆ 3 )l_Frame : ┆
0xf: 0000 00 00 01 5c 00 19 20 20 20 20 20 20 20 20 20 20 ┆ \ ┆