|
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: 5225 (0x1469) 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« └─⟦9a0e32f1f⟧ └─⟦this⟧
with expertSystem,instanceCounter; separate(expertSystem) package body classBehavior is type cellElement is record cell : element; free : boolean := TRUE; masked : boolean := FALSE; end record; type eltArray is array(1..taille) of cellElement; type classSet is record classArray : eltArray; count : natural := 0; end record; localClass : idC := 1; contents : classSet; theVisibleCollection : collection.object; theCompleteCollection : collection.object; function allocate(initValue : element) return expertSystem.reference is ref : expertSystem.reference; begin if contents.count + 1 = contents.classArray'LAST then raise classFull; end if; for i in contents.classArray'RANGE loop if contents.classArray(i).free then contents.count := contents.count + 1; contents.classArray(i) := cellElement'(initValue,FALSE,FALSE); ref.idObject := i; exit; end if; end loop; ref.idClass := localClass; ref.date := instanceCounter.newObject; collection.add(theVisibleCollection, ref); collection.add(theCompleteCollection, ref); return ref; end allocate; procedure allocate(initValue : element) is r : expertSystem.reference; begin r := allocate(initValue); end allocate; procedure dispose(aRef : expertSystem.reference) is begin if aRef.idClass /= localClass then raise badClass; end if; if contents.classArray(aRef.idObject).free then raise badReference; end if; contents.classArray(aRef.idObject).free := TRUE; contents.classArray(aRef.idObject).masked := FALSE; contents.count := contents.count - 1; collection.remove(theVisibleCollection, aRef); collection.remove(theCompleteCollection, aRef); end dispose; procedure clear is begin for i in contents.classArray'RANGE loop contents.classArray(i).free :=TRUE; contents.classArray(i).masked:=FALSE; end loop; collection.clear(theVisibleCollection); collection.clear(theCompleteCollection); end clear; procedure mask (aRef : expertSystem.reference) is begin if aRef.idClass /= localClass then raise badClass; end if; if contents.classArray(aRef.idObject).free then raise badReference; end if; if contents.classArray(aRef.idObject).masked=FALSE then contents.classArray(aRef.idObject).masked:=TRUE; collection.upDate(theCompleteCollection,aRef); collection.remove(theVisibleCollection,aRef); end if; end mask; procedure maskAll is begin for i in contents.classArray'RANGE loop contents.classArray(i).masked:=TRUE; end loop; collection.upDateAll(theCompleteCollection); collection.clear(theVisibleCollection); end maskAll; procedure unmask (aRef : expertSystem.reference) is sameRef : expertSystem.reference; aDate : long_integer; begin if aRef.idClass /= localClass then raise badClass; end if; if contents.classArray(aRef.idObject).free then raise badReference; end if; if contents.classArray(aRef.idObject).masked=TRUE then contents.classArray(aRef.idObject).masked:=FALSE; aDate:=instanceCounter.newObject; collection.upDate(theCompleteCollection,aRef,aDate); sameRef := aRef; sameRef.date :=aDate; collection.add(theVisibleCollection,sameRef); end if; end unmask; procedure unmaskAll is begin for i in contents.classArray'RANGE loop contents.classArray(i).masked:=FALSE; end loop; collection.upDateAll(theCompleteCollection); theVisibleCollection:=theCompleteCollection; end unmaskAll; function instances return collection.object is begin return theVisibleCollection; end instances; function allInstances return collection.object is begin return theCompleteCollection; end allInstances; function cardinality return natural is begin return contents.count; end cardinality; function get(aRef : expertSystem.reference) return element is begin if aRef.idClass /= localClass then raise badClass; end if; if contents.classArray(aRef.idObject).free then raise badReference; end if; return contents.classArray(aRef.idObject).cell; end get; procedure set(aRef : expertSystem.reference; withValue : element) is aDate : long_integer; begin if aRef.idClass /= localClass then raise badClass; end if; if contents.classArray(aRef.idObject).free then raise badReference; end if; contents.classArray(aRef.idObject).cell := withValue; aDate := instanceCounter.newObject; collection.upDate(theCompleteCollection,aRef,aDate); collection.upDate(theVisibleCollection,aRef,aDate); end set; function name return className is begin return surName; end name; function name(aRef : expertSystem.reference) return objectName is begin return refName(aRef); end name; begin localClass := instanceCounter.newClass(surname); end classBehavior;