|
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: 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