|
|
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: 2328 (0x918)
Types: TextFile
Notes: R1k Text-file segment
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦5f508eacb⟧
└─⟦this⟧
with expertSystem ; use expertSystem;
package instanceCounter is
function newObject return long_integer;
function newClass ( name : className) return positive;
function newContext ( name : contextName) return positive;
function contextNumber ( name : contextName) return natural;
function unknownClassName ( number : natural ) return className;
end instanceCounter;
package body instanceCounter is
numObject : long_integer := 0;
sizeClass : constant positive := className'LENGTH;
numClass : natural := 0;
namesClass : array(1..30) of string(1..sizeClass);
sizeContext : constant positive := contextName'LENGTH;
numContext : natural := 0;
namesContext : array(1..30) of string(1..sizeContext);
function newObject return long_integer is
begin
numObject := numObject + 1;
return numObject;
end newObject;
function newClass(name : className) return positive is
ln : positive := 1;
aName : string(1..sizeClass);
begin
numClass := numClass + 1;
if name'LENGTH > sizeClass then
ln := sizeClass;
else
ln := name'LENGTH;
end if;
aName(1..ln) := name(1..ln);
ln := ln + 1;
while ln <= sizeClass loop
aName(ln) := ' ';
ln := ln + 1;
end loop;
namesClass(numClass):=aName;
return numClass;
end newClass;
function newContext(name : contextName) return positive is
ln : positive := 1;
aName : string(1..sizeContext);
begin
numContext := numContext + 1;
if name'LENGTH > sizeContext then
ln := sizeContext;
else
ln := name'LENGTH;
end if;
aName(1..ln) := name(1..ln);
ln := ln + 1;
while ln <= sizeContext loop
aName(ln) := ' ';
ln := ln + 1;
end loop;
namesContext(numContext):=aName;
return numContext;
end newContext;
function contextNumber ( name : contextName) return natural is
begin
for i in 1..numContext loop
if name = namesContext(i) then
return(i);
end if;
end loop;
return(0);
end contextNumber;
function unknownClassName(number : natural) return className is
begin
return namesClass(number);
end unknownClassname;
end instanceCounter