|
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: 14336 (0x3800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package Our_Value, seg_04927c
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Ext_String, Lex, Text_Io;
package Our_Value is
subtype Var_String is Ext_String.Var_String;
type Var_Type is (Undefined, Type_Value, Type_Token,
Type_Boolean, Type_Integer, Type_String);
type Var_Value (Genre : Var_Type := Undefined) is limited private;
type P_Value is access Var_Value;
----------------------------------------------------------------------------
-- Exceptions --
----------------------------------------------------------------------------
Not_Implemented : exception;
Type_Conflict : exception;
procedure Signal_Not_Implemented;
function Verify_Type (Val : Var_Value; Type_Var : Var_Type) return Boolean;
----------------------------------------------------------------------------
-- procedures d'affectation (Set_Value => ":=") --
----------------------------------------------------------------------------
procedure Set_Value (Target : in out Var_Value; Source : Var_Value);
procedure Set_Value (Target : in out Var_Value; Source : P_Value);
procedure Set_Value (Target : in out Var_Value; Source : Lex.Token);
procedure Set_Value (Target : in out Var_Value; Source : Boolean);
procedure Set_Value (Target : in out Var_Value; Source : Integer);
procedure Set_Value (Target : in out Var_Value; Source : Var_String);
----------------------------------------------------------------------------
-- fonctions de consultations --
----------------------------------------------------------------------------
function Get_Type (Val : Var_Value) return Var_Type;
function Get_Type (Val : P_Value) return Var_Type;
function Get_Type (Val : Lex.Token) return Var_Type;
function Get_Type (Val : Boolean) return Var_Type;
function Get_Type (Val : Integer) return Var_Type;
function Get_Type (Val : Var_String) return Var_Type;
function Get_Value (Val : Var_Value) return Lex.Token;
function Get_Value (Val : Var_Value) return Boolean;
function Get_Value (Val : Var_Value) return Integer;
function Get_Value (Val : Var_Value) return Var_String;
function Get_Value (Val : P_Value) return Lex.Token;
function Get_Value (Val : P_Value) return Boolean;
function Get_Value (Val : P_Value) return Integer;
function Get_Value (Val : P_Value) return Var_String;
procedure Print_Value (Val : P_Value);
procedure Print_Value (Val : Var_Value);
----------------------------------------------------------------------------
-- Fonctions sur des operations unaires --
----------------------------------------------------------------------------
function Op (Operator : Lex.Token; Val : Var_Value) return Boolean;
function Op (Operator : Lex.Token; Val : Var_Value) return Integer;
----------------------------------------------------------------------------
-- Fonctions sur des operations binaires --
----------------------------------------------------------------------------
function Op (Operator : Lex.Token; Val1, Val2 : Var_Value) return Boolean;
function Op (Operator : Lex.Token; Val1, Val2 : Var_Value) return Integer;
function Op (Operator : Lex.Token; Val1, Val2 : Var_Value)
return Var_String;
----------------------------------------------------------------------------
-- Partie privee --
----------------------------------------------------------------------------
private
type Var_Value (Genre : Var_Type := Undefined) is
record
My_Type : Var_Type := Genre;
case Genre is
when Undefined =>
null;
when Type_Value =>
My_Value : P_Value;
when Type_Token =>
My_Token : Lex.Token;
when Type_Boolean =>
My_Boolean : Boolean;
when Type_Integer =>
My_Integer : Integer;
when Type_String =>
My_String : Var_String;
end case;
end record;
----------------------------------------------------------------------------
end Our_Value;
nblk1=d
nid=9
hdr6=c
[0x00] rec0=1e rec1=00 rec2=01 rec3=060
[0x01] rec0=12 rec1=00 rec2=04 rec3=00e
[0x02] rec0=14 rec1=00 rec2=0a rec3=02e
[0x03] rec0=00 rec1=00 rec2=05 rec3=05a
[0x04] rec0=1b rec1=00 rec2=08 rec3=052
[0x05] rec0=0c rec1=00 rec2=07 rec3=000
[0x06] rec0=18 rec1=00 rec2=07 rec3=000
[0x07] rec0=08 rec1=65 rec2=46 rec3=755
[0x08] rec0=f3 rec1=c2 rec2=00 rec3=005
[0x09] rec0=01 rec1=0c rec2=a8 rec3=6ea
[0x0a] rec0=bd rec1=41 rec2=30 rec3=000
[0x0b] rec0=a0 rec1=00 rec2=00 rec3=000
[0x0c] rec0=24 rec1=00 rec2=13 rec3=49e
tail 0x2154684ac865b5f43e539 0x42a00088462060003
Free Block Chain:
0x9: 0000 00 02 01 0f 80 47 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ┆ G----------┆
0x2: 0000 00 06 00 4e 80 34 2d 2d 20 46 6f 6e 63 74 69 6f ┆ N 4-- Fonctio┆
0x6: 0000 00 03 00 07 80 04 65 20 53 65 04 05 00 47 20 20 ┆ e Se G ┆
0x3: 0000 00 0d 03 fc 80 09 5f 42 6f 6f 6c 65 61 6e 3b 09 ┆ _Boolean; ┆
0xd: 0000 00 0c 02 59 00 36 66 75 6e 63 74 69 6f 6e 20 22 ┆ Y 6function "┆
0xc: 0000 00 0b 03 f9 80 15 61 6c 75 65 29 20 72 65 74 75 ┆ alue) retu┆
0xb: 0000 00 00 03 fc 00 36 66 75 6e 63 74 69 6f 6e 20 22 ┆ 6function "┆