|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: B T
Length: 13389 (0x344d)
Types: TextFile
Names: »B«
└─⟦afbc8121e⟧ Bits:30000532 8mm tape, Rational 1000, MC68020_OS2000 7_2_2
└─⟦77aa8350c⟧ »DATA«
└─⟦f794ecd1d⟧
└─⟦this⟧
with Action;
with Cmvc;
with Compilation;
with Debug_Tools;
with Directory;
with Io;
with Links_Implementation;
with Log;
with Object_Set;
with Profile;
with String_Map_Generic;
procedure Update_Models_To_7_2 is
package Naming renames Directory.Naming;
package Object_Op renames Directory.Object_Operations;
function "=" (X, Y : Naming.Name_Status) return Boolean renames Naming."=";
function "=" (X, Y : Directory.Error_Status) return Boolean
renames Directory."=";
function "=" (X, Y : Links_Implementation.Error_Status) return Boolean
renames Links_Implementation."=";
Skip_View : exception;
Release_Directory : constant String :=
"!targets.implementation.release_7_2_2";
Flavor_Directory : constant String :=
Release_Directory & ".motorola_68k.mc68020_os2000";
Map_Name : constant String := Flavor_Directory & ".model_map";
Worlds_Name : constant String := Flavor_Directory & ".model_world_list";
type String_Link is access String;
package Map is new String_Map_Generic
(Size => 10, Range_Type => String_Link);
Mm : Map.Map;
procedure Initialize_Map is
Map_File : Io.File_Type;
begin
Map.Initialize (Mm);
Io.Open (Map_File, Io.In_File, Map_Name);
while not Io.End_Of_File (Map_File) loop
declare
Domain_Name : constant String := Io.Get_Line (Map_File);
Range_Name : constant String := Io.Get_Line (Map_File);
begin
Map.Define (Mm, Domain_Name, new String'(Range_Name));
end;
end loop;
Io.Close (Map_File);
end Initialize_Map;
function Current_Model (View : String) return String is
Obj_Set_Name : constant String := View & ".state.model";
Obj_Set_Obj : Directory.Object;
Model_Set : Object_Set.Set;
Model_Obj : Directory.Object;
Iter : Object_Set.Iterator;
Nstatus : Naming.Name_Status;
Status : Directory.Error_Status;
begin
Directory.Naming.Resolve (Obj_Set_Name, Obj_Set_Obj, Nstatus);
if Nstatus /= Directory.Naming.Successful then
Log.Put_Line ("Could not find model " &
Obj_Set_Name & "; skipping view", Profile.Error_Msg);
raise Skip_View;
end if;
Object_Set.Open (Set_Id => Obj_Set_Obj,
The_Set => Model_Set,
Status => Status);
if Status /= Directory.Successful then
Log.Put_Line ("Could not open model " &
Obj_Set_Name & "; skipping view", Profile.Error_Msg);
raise Skip_View;
end if;
Object_Set.Init (Iter, Model_Set);
begin
Model_Obj := Object_Set.Value (Iter);
exception
when others =>
-- model corrupt for some reason
Log.Put_Line ("Model for " & View &
" is corrupt; using default model",
Profile.Warning_Msg);
Object_Set.Close (Model_Set, Status);
return "!MODEL.MC68020_OS2000_PORTABLE";
end;
Object_Set.Close (Model_Set, Status);
return Naming.Get_Full_Name (Model_Obj);
end Current_Model;
function Is_View (World_Obj : Directory.Object) return Boolean is
Subc : constant String := Directory.Subclass_Image
(Directory.Get_Subclass (World_Obj));
begin
return Subc = "LOAD_VIEW" or else
Subc = "COMBINED_VIEW" or else Subc = "SPEC_VIEW";
end Is_View;
function Is_Released_View (World_Obj : Directory.Object) return Boolean is
Name : constant String := Naming.Get_Full_Name (World_Obj);
Last : constant Integer := Name'Last;
begin
if Name (Last - 4 .. Last) = "_SPEC" then
return False;
elsif Name (Last - 7 .. Last) = "_WORKING" then
return False;
else
return True;
end if;
end Is_Released_View;
function Is_World (World_Obj : Directory.Object) return Boolean is
Subc : constant String := Directory.Subclass_Image
(Directory.Get_Subclass (World_Obj));
begin
return Subc = "WORLD";
end Is_World;
procedure Replace_Model (View : String) is
Old_Model : constant String := Current_Model (View);
begin
Cmvc.Replace_Model
(New_Model => Map.Eval (Mm, Old_Model).all, In_View => View);
exception
when Map.Undefined =>
Log.Put_Line ("In view " & View &
", could not map model " & Old_Model &
" to new model - not specified in mapping",
Profile.Warning_Msg);
end Replace_Model;
procedure Update_Links (World : Directory.Object) is
package Li renames Links_Implementation;
Pack_Handle : Li.Pack_Handle;
Status : Li.Error_Status;
Iter : Li.Iterator;
Old_Path : constant String := "!Targets.Mc68020_Os2000";
New_Path : constant String :=
"!Targets.Predefined.Mc68020_Os2000_7_2.Units";
World_Name : constant String := Naming.Get_Full_Name (World);
Ul_Action : Action.Id;
begin
if World_Name (World_Name'First .. World_Name'First + 5) =
"!MODEL" or else
(World_Name'Length > 22 and then
World_Name (World_Name'First .. World_Name'First + 22) =
"!TARGETS.MC68020_OS2000") then
-- don't change the links for models
return;
end if;
Log.Put_Line ("Updating links for " & World_Name,
Profile.Auxiliary_Msg);
Ul_Action := Action.Start;
Li.Open (Pack_Handle, World, Status,
Mode => Li.Update,
Action_Id => Ul_Action);
if Status /= Li.Successful then
Log.Put_Line ("Error in opening link pack for " &
World_Name & ": " & Li.Image (Status),
Profile.Error_Msg);
Action.Finish (Ul_Action, Do_Commit => False);
else
begin
Li.Init (Iter, Pack_Handle, Status, Old_Path & ".?");
if Status /= Li.Successful then
Log.Put_Line ("Error in obtaining iterator for " &
World_Name & ": " & Li.Image (Status),
Profile.Error_Msg);
else
while not Li.Done (Iter) loop
declare
Source_String : constant String := Li.Source (Iter);
begin
Li.Delete (Pack_Handle, Status, Source_String);
if Status /= Li.Successful then
Log.Put_Line ("Error in deleting " &
Source_String & "from " &
World_Name & ": " &
Li.Image (Status),
Profile.Error_Msg);
else
Li.Add (Pack_Handle, Status,
New_Path &
Source_String
(Old_Path'Length + 1 ..
Source_String'Length));
if Status /= Li.Successful then
Log.Put_Line
("Error in adding " & New_Path &
Source_String
(Old_Path'Length + 1 ..
Source_String'Length) &
": " & Li.Image (Status),
Profile.Error_Msg);
end if;
end if;
Li.Next (Iter);
end;
end loop;
end if;
Li.Close (Pack_Handle, Status);
Action.Finish (Ul_Action, Do_Commit => True);
exception
when others =>
Log.Put_Line ("Exception while updating " &
World_Name & ": " &
Debug_Tools.Get_Exception_Name (True, True));
Li.Close (Pack_Handle, Status);
Action.Finish (Ul_Action, Do_Commit => False);
end;
end if;
end Update_Links;
procedure Process_Worlds is
World_File : Io.File_Type;
begin
begin
Io.Open (World_File, Io.In_File, Worlds_Name);
exception
when others =>
Log.Put_Line ("Could not open world file: " & Worlds_Name,
Profile.Warning_Msg);
return;
end;
while not Io.End_Of_File (World_File) loop
declare
Worlds : constant String := Io.Get_Line (World_File);
Iter : Naming.Iterator;
World : Directory.Object;
Nstatus : Naming.Name_Status;
Estatus : Directory.Error_Status;
begin
Naming.Resolve (Iter, Worlds, Nstatus);
if Nstatus /= Naming.Successful and then
Nstatus /= Naming.Ambiguous then
Log.Put_Line ("Could not resolve world " & Worlds,
Profile.Warning_Msg);
raise Skip_View;
end if;
while not Naming.Done (Iter) loop
begin
Naming.Get_Object (Iter, World, Estatus);
if Estatus /= Directory.Successful then
Log.Put_Line ("Could not resolve world " &
Naming.Target_Name (Iter, Worlds),
Profile.Error_Msg);
else
if Is_View (World) then
if Is_Released_View (World) then
Log.Put_Line
("Not updating released view " &
Naming.Get_Full_Name (World),
Profile.Warning_Msg);
else
-- Unfreeze World
Object_Op.Unfreeze_Object (World, Estatus);
if Estatus /= Directory.Successful then
Log.Put_Line
("Could not unfreeze " &
Naming.Get_Full_Name (World),
Profile.Warning_Msg);
end if;
-- Alter Model
Replace_Model
(Naming.Get_Full_Name (World));
end if;
elsif Is_World (World) then
-- Unfreeze World
Object_Op.Unfreeze_Object (World, Estatus);
if Estatus /= Directory.Successful then
Log.Put_Line ("Could not unfreeze " &
Naming.Get_Full_Name (World),
Profile.Warning_Msg);
end if;
-- Update Links
Update_Links (World);
end if;
end if;
exception
when Skip_View =>
null;
when others =>
Log.Put_Line ("Exception while processing " &
Naming.Get_Full_Name (World),
Profile.Error_Msg);
end;
Naming.Next (Iter);
end loop;
exception
when Skip_View =>
null;
end;
end loop;
Io.Close (World_File);
end Process_Worlds;
begin
Log.Put_Line ("Updating worlds to 7_2", Profile.Auxiliary_Msg);
Log.Put_Line ("Initializing model map", Profile.Auxiliary_Msg);
Initialize_Map;
Log.Put_Line ("Processing Worlds", Profile.Auxiliary_Msg);
Process_Worlds;
Log.Put_Line ("End of updating worlds", Profile.Auxiliary_Msg);
exception
when others =>
Log.Put_Line ("Exception while fixing up models: " &
Debug_Tools.Get_Exception_Name (True, True),
Profile.Exception_Msg);
end Update_Models_To_7_2;
pragma Main;