HP 3000 Manuals HP 3000 Manuals
SPL Example Program
$control map
<<****************************************************************>>
<<* *>>
<<* This SPL program gives examples of calling System Dictionary *>>
<<* intrinsics. The examples in this program include *>>
<<* *>>
<<* Procedure Example *>>
<<* ------------------ ---------------------------------------- *>>
<<* OpenDictionary Shows how to open a System Dictionary *>>
<<* *>>
<<* CloseDictionary Shows how to close a System Dictionary *>>
<<* *>>
<<* FindElements Shows how to find relationships, when *>>
<<* only one of the entities of the *>>
<<* relationship is known, using the *>>
<<* SDFindRelList intrinsic *>>
<<* *>>
<<* FindByNumber The same example as shown in procedure *>>
<<* FindElements, but internal numbers are *>>
<<* used instead of names. *>>
<<* *>>
<<* CreateElement Shows how to create an entity occurrence *>>
<<* using both internal and external names *>>
<<* *>>
<<* LinkElement Shows how to link a local domain entity *>>
<<* to a common domain entity *>>
<<* *>>
<<* RemoveRelationshipLink Shows how to remove a link between a *>>
<<* local domain relationship and a common *>>
<<* domain relationship. *>>
<<* *>>
<<****************************************************************>>
begin
equate EndOfListStatus = 24;
equate GoodStatus = 0;
equate SingleSpace = %40;
equate NoSpace = %320;
double array Dcb(0:29);
intrinsic dascii;
intrinsic print;
intrinsic read;
intrinsic SDFindRelList;
intrinsic SDCreateEnt;
intrinsic SDGetAttr;
intrinsic SDGetEnt;
intrinsic SDGetEntType;
intrinsic SDModifyRel;
intrinsic SDOpen;
intrinsic SDClose;
<<****************************************************************>>
<<* *>>
<<* SystemDictionaryError *>>
<<* *>>
<<* This procedure reports the error number returned in the *>>
<<* Status parameter from a System Dictionary intrinsic call *>>
<<* *>>
<<****************************************************************>>
begin
logical array Message(0:35);
integer NumChar;
move Message := "System Dictionary Error # ";
NumChar := dascii(Status(0), 10, Message(13));
print(Message, -26-NumChar, SingleSpace);
end;
$page
<<****************************************************************>>
<<* *>>
<<* FindElements *>>
<<* *>>
<<* This procedure finds all elements related to the record *>>
<<* ACCOUNTS-RECORD. It uses the intrinsic SDFindRelList to *>>
<<* search for the elements. The procedure then calls SDGetEnt *>>
<<* to retrieve the COUNT, ELEMENT-TYPE and BYTE-LENGTH *>>
<<* attributes of the element *>>
<<* *>>
<<****************************************************************>>
procedure FindElements;
begin
logical array AttributeList(0:15);
integer CharCount;
byte array CommonEntity(0:31);
double pointer Count;
logical array ElementAttributes(0:4);
logical pointer ElementType;
double pointer ByteLength;
logical array EntityList(0:47);
logical array EntitySearchList(0:9);
logical array EntityType(0:15);
logical array Message(0:35);
logical array RelationshipClass(0:15);
logical array RelationshipType(0:8);
double array RetrievalID(0:19);
double array Status(0:6);
@Count := @ElementAttributes(0);
@ElementType := @ElementAttributes(2);
@ByteLength := @ElementAttributes(3);
print(Message, 0, SingleSpace);
move Message := "*** Elements related to ACCOUNTS-RECORD ***";
print(Message, -43, SingleSpace);
print(Message, 0, SingleSpace);
move Message := "Element Count Type Length";
print(Message, -49, SingleSpace);
move RelationshipType := "RECORD ELEMENT;";
move RelationshipClass := "CONTAINS ";
move EntitySearchList := "ACCOUNTS-RECORD ?;";
move EntityType := "ELEMENT ";
move AttributeList := "COUNT ELEMENT-TYPE BYTE-LENGTH;";
RetrievalID(0) := 0 D;
do begin
SDFindRelList(Dcb, RelationshipType, RelationshipClass,
EntitySearchList, RetrievalID, EntityList, Status);
if (Status(0) = GoodStatus D) then
begin
SDGetEnt(Dcb, EntityType, EntityList(16), AttributeList,
ElementAttributes, CommonEntity, Status);
if Status(0) <> GoodStatus D then
SystemDictionaryError(Status);
move Message := 36(" ");
move Message := EntityList(16), (16);
CharCount := dascii(Count, 10, Message(16));
Message(22) := ElementType;
CharCount := dascii(ByteLength, 10, Message(23));
print(Message, -56, SingleSpace);
end;
end
until Status(0)
GoodStatus D;
end;
$page
<<****************************************************************>>
<<* *>>
<<* OpenDictionary *>>
<<* *>>
<<* This procedure opens the System Dictionary SYSDIC.PUB.SYS *>>
<<* with the PROGRAMMER scope, the local domain D, and the test *>>
<<* test version. *>>
<<* *>>
<<****************************************************************>>
procedure OpenDictionary;
begin
byte array Dictionary(0:25);
logical array Scope(0:15);
byte array Password(0:31);
logical array Domain(0:15);
logical array Version(0:15);
double array Status(0:6);
move Dictionary := "SYSDIC.PUB.SYS ";
move Scope := "PROGRAMMER ";
move Password := "SECRET ";
move Domain := "D ";
mov*e Version := " ";
SDOpen(Dictionary, Scope, Password, 3 D, 2 D, Domain,
Version, 1 D, Dcb, Status);
if Status(0) <> GoodStatus D then
begin
SystemDictionaryError(Status);
end;
end;
$page
<<****************************************************************>>
<<* *>>
<<* CloseDictionary *>>
<<* *>>
<<* This procedure closes the System Dictionary *>>
<<* *>>
<<****************************************************************>>
procedure CloseDictionary;
begin
double array Status(0:6);
SDClose(Dcb, Status);
if Status(0) <> GoodStatus D then
begin
SystemDictionaryError(Status);
end;
end;
$page
<<****************************************************************>>
<<* *>>
<<* FindByNumber *>>
<<* *>>
<<* This procedure finds all elements related to the record *>>
<<* ACCOUNTS-RECORD. It uses the intrinsic SDFindRelList to *>>
<<* search for the elements. The procedure then calls SDGetEnt *>>
<<* to retrieve the COUNT, ELEMENT-TYPE and BYTE-LENGTH *>>
<<* attributes of the element. It is similar to the procedure *>>
<<* FindElements, except internal numbers are used whenever *>>
<<* possible. *>>
<<* *>>
<<* The use of internal numbers will improve the performance of *>>
<<* System Dictionary intrinsic calls *>>
<<* *>>
<<****************************************************************>>
procedure FindByNumber;
begin
logical array Attribute(0:15);
logical array AttributeEdits(0:127);
double array AttributeNumberList(0:3);
double array AttributeParms(0:1);
double pointer ByteLength;
integer CharCount;
logical array CommonEntity(0:15);
double pointer Count;
double EditsLength;
logical array ElementAttributes(0:4);
logical pointer ElementType;
double array EntityNumber(0:1);
logical array EntityList(0:48);
logical array EntitySearchList(0:9);
logical array EntityType(0:15);
double array EntityTypeNumber(0:1);
logical array Message(0:35);
logical array OwnerScope(0:15);
logical array RelationshipClass(0:15);
logical array RelationshipType(0:7);
double array RetrievalID(0:19);
double array Status(0:6);
@Count := @ElementAttributes(0);
@ElementType := @ElementAttributes(2);
@ByteLength := @ElementAttributes(3);
print(Message, 0, SingleSpace);
move Message := "*** Elements related to ACCOUNTS-RECORD ***";
print(Message, -43, SingleSpace);
print(Message, 0, SingleSpace);
move Message := "Element Count Type Length";
print(Message, -41, SingleSpace);
move RelationshipType := "RECORD ELEMENT;";
move RelationshipClass := "CONTAINS ";
move EntitySearchList := "ACCOUNTS-RECORD ?;";
RetrievalID(0) := 0 D;
move EntityType := "ELEMENT ";
SDGetEntType(Dcb, EntityType, OwnerScope, Status);
if Status(0) <> GoodStatus D then
begin
SystemDictionaryError(Status);
end;
EntityTypeNumber(0) := 1 D;
EntityTypeNumber(1) := Status(4);
AttributeNumberList(0) := 3 D;
move Attribute := "COUNT ";
SDGetAttr(Dcb, Attribute, AttributeParms, AttributeEdits, EditsLength,
OwnerScope, Status);
AttributeNumberList(1) := Status(4);
move Attribute := "ELEMENT-TYPE ";
SDGetAttr(Dcb, Attribute, AttributeParms, AttributeEdits, EditsLength,
OwnerScope, Status);
AttributeNumberList(2) := Status(4);
move Attribute := "BYTE-LENGTH ";
SDGetAttr(Dcb, Attribute, AttributeParms, AttributeEdits, EditsLength,
OwnerScope, Status);
AttributeNumberList(3) := Status(4);
do begin
SDFindRelList(Dcb, RelationshipType, RelationshipClass,
EntitySearchList, RetrievalID, EntityList, Status);
if (Status(0) = GoodStatus D) then
begin
EntityNumber(0) := 1 D;
EntityNumber(1) := Status(4);
SDGetEnt(Dcb, EntityTypeNumber, EntityNumber, AttributeNumberList,
ElementAttributes, CommonEntity, Status);
if (Status(0)
GoodStatus D) then
begin
SystemDictionaryError(Status);
end;
move Message := 36(" ");
move Message := EntityList(16), (16);
CharCount := dascii(Count, 10, Message(16));
Message(22) := ElementType;
CharCount := dascii(ByteLength, 10, Message(23));
print(Message, -56, SingleSpace);
end;
end
until Status(0) <> GoodStatus D;
end;
$page
<<****************************************************************>>
<<* *>>
<<* CreateElement *>>
<<* *>>
<<* This procedure creates an entity occurrence by calling the *>>
<<* intrinsic SDCreateEnt. The entity being created has both *>>
<<* an internal and external name being specified. *>>
<<* *>>
<<****************************************************************>>
procedure CreateElement;
begin
logical array AttributeList(0:15);
double pointer ByteLength;
logical array CommonEntity(0:15);
double pointer Count;
logical array ElementAttributes(0:4);
byte pointer ElementType;
logical array EntityType(0:15);
logical array Entity(0:32);
double array Status(0:6);
@Count := @ElementAttributes(0);
@ElementType := @ElementAttributes(2);
@ByteLength := @ElementAttributes(3);
move EntityType := "ELEMENT ";
move Entity := "DATE ";
move Entity(16) := "DELIVERY-DATE ";
move AttributeList := "COUNT ELEMENT-TYPE BYTE-LENGTH;";
Count := 1 D;
move ElementType := "X ";
ByteLength := 6 D;
move CommonEntity := 16(" ");
SDCreateEnt(Dcb, EntityType, Entity, AttributeList,
ElementAttributes, CommonEntity, Status);
if Status(0) <> GoodStatus D then
begin
SystemDictionaryError(Status);
end;
end;
$page
<<****************************************************************>>
<<* *>>
<<* LinkElements *>>
<<* *>>
<<* This procedure links a local domain entity to a common *>>
<<* domain entity. The procedure calls SDCreateEnt to create *>>
<<* the entity in the local domain, and at the same time link *>>
<<* it to the common domain entity. *>>
<<* *>>
<<****************************************************************>>
procedure LinkEntity;
begin
logical AttributeList;
byte pointer ByteLength;
logical array CommonEntity(0:15);
double pointer Count;
logical array ElementAttributes(0:4);
byte pointer ElementType;
logical array EntityType(0:15);
logical array Entity(0:31);
double array Status(0:6);
move EntityType := "ELEMENT ";
move Entity := "P-NUM ";
move Entity(16) := 16(" ");
AttributeList := "; ";
move CommonEntity := "PART-NUMBER ";
SDCreateEnt(Dcb, EntityType, Entity, AttributeList,
ElementAttributes, CommonEntity, Status);
if Status(0) <> GoodStatus D then
begin
SystemDictionaryError(Status);
end;
end;
$page
<<****************************************************************>>
<<* *>>
<<* RemoveRelationshipLink *>>
<<* *>>
<<* This procedure removes the link between a relationship in *>>
<<* a local domain and a relationship in the common domain. The *>>
<<* procedure calls SDModifyRel to remove the link. The *>>
<<* parameter CommonEntityList is set to '/;' to instruct *>>
<<* SDModifyRel to remove the link. *>>
<<* *>>
<<****************************************************************>>
procedure RemoveRelationshipLink;
begin
logical AttributeList;
double AttributeValues;
logical CommonEntityList;
logical array EntityList(0:15);
logical array RelationshipClass(0:15);
logical array RelationshipType(0:8);
double array Status(0:6);
move RelationshipType := "RECORD ELEMENT;";
move RelationshipClass := "CONTAINS ";
move EntityList := "ACCOUNTS-RECORD ACCOUNT-NUMBER;";
AttributeList := "; ";
CommonEntityList := "/;";
SDModifyRel(Dcb, RelationshipType, RelationshipClass, EntityList,
AttributeList, AttributeValues, CommonEntityList, Status);
if Status(0) <> GoodStatus D then
begin
SystemDictionaryError(Status);
end;
end;
OpenDictionary;
FindElements;
FindByNumber;
CreateElement;
LinkEntity;
RemoveRelationshipLink;
CloseDictionary;
end.