mbenveni@tango.irisa.fr (Marc Benveniste) (12/11/89)
%%To: mbenveni@irisa.irisa.fr
%%Subject: Re: TopSpeed Modula-2 for Novell's Btrieve
%%Newsgroups: comp.lang.modula2
%%In-Reply-To: <1799@irisa.irisa.fr>
%%References: <2746@ethz.UUCP>
%%Organization: Pacific Systems Group, Portland Oregon US
%%
%%In article <1799@irisa.irisa.fr> you write:
%%>I am sorry if I interfere in some deal, but I happen to have
%%>a Modula-2 interface to Btrieve which I am willing to share
%%>for free. I wonder if I should post it or mail it directly
%%>to the one who asked for it.
%%
%%Post it please.
So here it goes. 3 modules are necessary: a low level memory copy
module (copymem.{def,mod}), a generic lists module (lists.{def,mod})
and btrieve.{def,mod}. I only ask users NOT to remove the comments
placed at the beginning of each module. I don't promess these modules
are error free but at least I am sure that CopyMemory and Lists
are OK. A great deal of Btrieve has been tested and no apparent
error has arised. I used it in a single user environment so I did
not have the chance to test function calls related to locking and
multiuser applications.
The btrieve file is defined as an opaque type in order to provide
some protection. Comments in Btrieve.def are not terminated but
with SoftCraft user's manual and source code it shouldn't be too
difficult to finish a proper module documentation.
Marc Benveniste mbenveni@irisa.irisa.fr
(Ph.D. student)
IRISA-INRIA
Campus de Beaulieu
35042 Rennes
FRANCE
#################### SOURCES: DEFINITION MODULES ####################
DEFINITION MODULE CopyMem;
(*==========================================================================
Global Description : This module provides procedures to copy
unstructured data. Overlapping Address ranges
currently not implemented.
________________________________________________________________________
FirstEdit: 20/05/87
LastEdit : 2/07/87
________________________________________________________________________
Author : Marc Benveniste
System : Logitech MODULA-2/86 V. 2.05
Developped while
working at : IIMAS-UNAM,
Apdo. Postal 20-726,
Mexico D.F., 01000
MEXICO
===========================================================================*)
FROM SYSTEM IMPORT
(* Type *) ADDRESS;
TYPE
ByteRange = [0 .. 32*1024-2];
WordRange = [0 .. 16*1024-2];
PROCEDURE CopyByte(From, To: ADDRESS; ByteNum: ByteRange);
(*_________________________________________________________________________
In ---> From = Address of source.
To = Address of destination.
ByteNum = Number of bytes to copy.
SideEffect ---> Bytes at addresses From+i are copied to addresses To+i
for i=0 to ByteNum-1. Overlapping addresses range are
NOT taken care of. Address overflow is NOT checked for.
_________________________________________________________________________*)
PROCEDURE CopyWord(From, To: ADDRESS; WordNum: WordRange);
(*_________________________________________________________________________
In ---> From = Address of source.
To = Address of destination.
WordNum = Number of words to copy.
SideEffect ---> Words at addresses From+2*i are copied to addresses To+2*i
for i=0 to WordNum-1. Overlapping addresses range are
NOT taken care of. Address overflow is NOT checked for.
_________________________________________________________________________*)
PROCEDURE FillByte(B: CHAR; To: ADDRESS; ByteNum: ByteRange);
(*_________________________________________________________________________
In ---> B = Byte to fill with.
To = Address of first byte of area to fill.
ByteNum = Number of bytes to write.
SideEffect ---> Bytes at addresses To+i are overwritten with B for
i=0 to ByteNum. Address overflow is NOT checked for.
_________________________________________________________________________*)
PROCEDURE FillWord(C: CARDINAL; To: ADDRESS; WordNum: WordRange);
(*_________________________________________________________________________
In ---> C = Word to fill with.
To = Address of first word of area to fill.
WordNum = Number of words to write.
SideEffect ---> Words at addresses To+2*i are overwritten with C for
i=0 to WordNum. Address overflow is NOT checked for.
_________________________________________________________________________*)
END CopyMem.
DEFINITION MODULE Lists;
(*==========================================================================
Global Description : This module provides generic linked lists
A list is a couple ( L, IO ) where L is the list structure and IO is
a variable of the type of the elements that L can handle. When creating
the structure a variable must be assigned to it. The role of that variable
is double:
1)- It provides the base type of the list structure,
2)- it is the port to the list, insuring type checking.
Operations on the list structure IMPLICITELY use the IO variable.
That's why these operations are described as side effects. A single IO
variable may be the port to many lists as long as all lists are of the
same base type.
_______________
__: WARNING :__
The port of a list structure MUST have the same LIFELENGTH and SCOPE
as the structure itself.
________________________________________________________________________
FirstEdit: 23/03/87
LastEdit : 2/07/87
________________________________________________________________________
Author : Marc Benveniste
System : Logitech MODULA-2/86 V. 2.05
Developped while
working at : IIMAS-UNAM,
Apdo. Postal 20-726,
Mexico D.F., 01000
MEXICO
===========================================================================*)
FROM SYSTEM IMPORT
(* Type *) ADDRESS;
EXPORT QUALIFIED
(* Type *) List,
(* Var *) ListError,
(* Procedure *) NewList, IsEmpty, First, Remove,
Insert, Next, Dispose;
TYPE
List;
VAR
ListError : CARDINAL;
(*______: Possible error codes :__________________________________________
0 --------> No error ocurred,
1 --------> General failure,
2 --------> Out of memory,
3 --------> Tried to REMOVE or FIRST on an empty list or position,
4 --------> Tried to DISPOSE of a non-empty list,
5 --------> No next element available.
_________________________________________________________________________*)
PROCEDURE NewList(IOPort: ADDRESS; ElemTypeSize: CARDINAL): List;
(*______________________________________________________________________
NewList creates, if possible, a list ready to handle a given TYPE
of objects. The only way to interact with the list is through it's
port. The port must be a VAR with the same life length and scope as
the new list.
In --> IO ::= The address of the port variable of list.
TypeSize ::= Size of the TYPE of the list's port.
Out -> An empty list ready to handle elements of size TypeSize
through port at address IO if no error ocurred.
SideEffect ---> ListError is set to 0 or 2.
______________________________________________________________________*)
PROCEDURE IsEmpty(VAR L : List): BOOLEAN;
(*_________________________________________________________________________
IsEmpty is True if L is an empty list; False otherwise.
In ----> L ::= A list obtained by means of a successful NewList call.
Out ----> L ::= Untouched
IsEmpty ::= TRUE if L is empty; FALSE otherwise.
SideEffect ---> ListError is set to 0 or 1.
_________________________________________________________________________*)
PROCEDURE First(VAR L: List);
(*_________________________________________________________________________
First places in the port assigned to L the head element of the list
structure L, and makes it the current element. ListError may be 0,1 or 3.
In ----> L ::= A list obtained by means of a successful New call.
Out ----> L ::= The Head of L has become the current element
SideEffect ---> A copy of the Head of L is in its port.
ListError is set to 0,1 or 3.
_________________________________________________________________________*)
PROCEDURE Insert(VAR L: List);
(*_________________________________________________________________________
Insert makes a copy of the element in the port assigned to L and
inserts it in the list structure immediately before the current element;
The inserted element becomes the current one. If L is empty then the copy
becomes the head and current element. ListError may be 0,1 or 2.
In ---> L = Any legal List.
Out ---> L = The input list with a copy of it's port's content
inserted in front of it's current element.
SideEffect ---> ListError is set according to the result of the operation.
The current element of the list is the inserted one if
ListError is 0.
_________________________________________________________________________*)
PROCEDURE Remove(VAR L: List);
(*_________________________________________________________________________
The current element is removed from the list. Next element becomes the
current one. A copy of that element is in the port associated to L.
ListError may be 0,1,3 or 5.
In ---> L = Any legal List.
Out ---> L = The input list with it's current element removed.
SideEffect ---> ListError is set to 0,1,3 or 5.
The List's port contains a copy of the current element,
if any.
_________________________________________________________________________*)
PROCEDURE Next(VAR L: List);
(*_________________________________________________________________________
A copy of the next element of the current one is available in the
port associated to L. That element also becomes the current one.
ListError may be 0,1 or 5.
In ---> L = Any legal List.
Out ---> L = The input list.
SideEffect ---> ListError is set to 0,1 or 5.
A copy of the next element, if any, of the current one
is in the port. That one also becomes the current one.
_________________________________________________________________________*)
PROCEDURE Dispose(VAR L: List);
(*_________________________________________________________________________
If L is empty, Dispose frees the allocated memory and L becomes an
invalid data. ListError may be 0,1 or 4.
In ---> L = Any legal empty List.
Out ---> L = Meaningless data if ListError = 0; same data otherwise.
SideEffect ---> ListError is set to 0,1 or 4.
_________________________________________________________________________*)
END Lists.
DEFINITION MODULE Btrieve;
(*==========================================================================
Global Description : Modula-2/86 interface to Btrieve V. 4.04
________________________________________________________________________
FirstEdit: 17/03/87
LastEdit : 25/09/87
________________________________________________________________________
Author : Marc Benveniste
System : Logitech MODULA-2/86 V. 2.05
Developped while
working at : IIMAS-UNAM,
Apdo. Postal 20-726,
Mexico D.F., 01000
MEXICO
===========================================================================*)
FROM SYSTEM IMPORT
(* Type *) ADDRESS;
FROM Lists IMPORT
(* Type *) List;
EXPORT QUALIFIED
(* Constants *) MaxPageSizeMult,MinRecLgth,MaxRecLgth,
MaxKeyNum,MaxKeyLgth,
(* Type *) BtrvFile, BtrvFilePtr,
OrderStruct, KeyNum,
RelationalOp, OpeningMode, PhysRecAdr,
DataInfo, LogicalDrive, OwnerName,
LongCard, RecsPerKey,
(* Var *) Status, FileStruct, StructList,
(* Procedures to manage System *) GetDirectory, Reset, SetDirectory,
Stop, Version,
(* Procedures to manage Files *) ClearOwner, Close, Create,
Extend, Open, SetOwner, Stat,
(* Procedures to manage Operations *) AbortTransaction, BeginTransaction,
ClearLocking, EndTransaction,
SetNoWaitLocking, SetWaitLocking,
Unlock,
(* Procedures to operate on Records *) Delete, GetDirect, GetKey, GetRecord,
GetPosition,
Insert, StepDirect, Update;
CONST
FileSpec = TRUE;
KeySpec = FALSE;
PageSizeUnit = 512;
MinOverhead = 12;
MaxPageSizeMult = 8;
MaxPageSize = MaxPageSizeMult*PageSizeUnit;
MaxKeyLgth = 255;
MinRecLgth = 8;
MaxRecLgth = MaxPageSize - MinOverhead;
MaxKeyNum = 24;
TYPE
BtrvFile ;
BtrvFilePtr = POINTER TO BtrvFile;
PhysRecAdr ;
OwnerName = ARRAY[0 .. 8] OF CHAR;
LongCard = RECORD
Low, High : CARDINAL
END;
KeyNum = [0 .. MaxKeyNum - 1];
RecsPerKey = ARRAY KeyNum OF LongCard;
DataInfo = RECORD
DataBufAdr : ADDRESS;
DataBufLth : CARDINAL;
KeyBufAdr : ADDRESS;
KeyBufLth : [1 .. MaxKeyLgth];
Key : POINTER TO KeyNum
END; (* record *)
LogicalDrive = (Default,A,B,C,D,E,F,G);
OrderStruct = RECORD
CASE Exists: BOOLEAN OF
TRUE : Name : ARRAY[0 .. 7] OF CHAR;
Def : ARRAY[0 .. 255] OF CHAR
END (* case *)
END; (* record *)
RelationalOp = (Equal,Next,Previous,Greater,GrOrEq,
LessThan,LTOrEq,Lowest,Highest);
OpeningMode = (Verify,ReadOnly,Accelerated,Normal);
VAR
Status : CARDINAL;
(*_______________________________________________________________________*
* *
* 0 ---> Operation was Successfull, *
* 1 ---> Out of Memory, used to be invalid operation code. *
* *
* Consult Appendix B of the Btrieve Reference Manual *
* for the other Status codes. *
*_______________________________________________________________________*)
FileStruct : RECORD
CASE Spec : BOOLEAN OF
FileSpec :
RecordLgth : [MinRecLgth .. MaxRecLgth];
PageSizeMult : [1 .. MaxPageSizeMult];
IndexesNum : [1 .. MaxKeyNum];
VarLgthRec : BOOLEAN |
KeySpec :
KeyPos : [0 .. MaxRecLgth - 1];
KeyLgth : [1 .. MaxKeyLgth];
Duplicates,
Modifiable,
Segmented : BOOLEAN ;
CASE NullKey : BOOLEAN OF
TRUE : NullChar : CHAR;
END; (* case *)
CASE Binary : BOOLEAN OF
FALSE : AltColSeq : BOOLEAN;
END (* case *)
END (* case *)
END; (* record *)
StructList : List;
(* FileStruct and StructList form a List pair as defined in the Definition
Module Lists.def. The operations allowed on them by the mentioned Module
should be the only ones used. This pair is implicitely used with the
Create and Stat operations. StructList is an empty linked list structure
ready to handle objects of the same type of FileStruct. The communication
with the list structure can only be obtained using the variable
FileStruct as a communication port as stated in the Lists Module.
Please refer the that Module for more information. *)
(*_______________________________________________________________________
P R O C E D U R E S T O M A N A G E T H E S Y S T E M
_______________________________________________________________________*)
PROCEDURE GetDirectory(Drv: LogicalDrive;VAR DirPath: ARRAY OF CHAR);
(*_______________________________________________________________________
In ----> DirPath = Array of char at least 64 chars long.
Out ----> DirPath = Full path name terminated by a 00h.
Side Effect ---->
_______________________________________________________________________*)
PROCEDURE Reset(OwnStation: BOOLEAN; VAR OtherInfo: ARRAY OF CHAR);
PROCEDURE SetDirectory(DirPath: ARRAY OF CHAR);
PROCEDURE Stop;
PROCEDURE Version(VAR VerNum,RevNum: CARDINAL; VAR Slash: CHAR);
(*_______________________________________________________________________
P R O C E D U R E S T O M A N A G E T H E F I L E S
_______________________________________________________________________*)
PROCEDURE ClearOwner(File : BtrvFile);
PROCEDURE Close(VAR File : BtrvFile);
PROCEDURE Create(FileName: ARRAY OF CHAR; VAR AltColSeq: OrderStruct);
(*_______________________________________________________________________
In ----> FileName = Any legal MS-DOS file name ending with
a 20h or 00h.
Out ---->
Side Effect ----> Uses implicitely StructList. If it is empty, Status
will be set to 25 and no action will be performed.
_______________________________________________________________________*)
PROCEDURE Extend(File: BtrvFile; FileName: ARRAY OF CHAR; Now: BOOLEAN);
(*_______________________________________________________________________
In ----> FileName = Any legal MS-DOS file name ending it
with a 20h or 00h.
Out ---->
Side Effect ---->
_______________________________________________________________________*)
PROCEDURE Open(FileName: ARRAY OF CHAR; Owner: OwnerName;
Mode : OpeningMode ): BtrvFile;
PROCEDURE SetOwner(File: BtrvFile;Owner: OwnerName;
AnyAccess, Encryption:BOOLEAN );
PROCEDURE Stat(File: BtrvFile; VAR RecNum: LongCard;VAR Freq: RecsPerKey;
VAR AltColSeq: OrderStruct; VAR ExtFileName: ARRAY OF CHAR);
(*_______________________________________________________________________
In ----> ExtFileName = Array of char at least 64 chars long.
Out ----> ExtFileName = Full name, terminated by a 00h, of
the file to which an Extend was
previously performed; 00h if no one.
Side Effect ----> Uses implicitely StructList.
_______________________________________________________________________*)
(*_______________________________________________________________________
P R O C E D U R E S T O M A N A G E O P E R A T I O N S
_______________________________________________________________________*)
PROCEDURE AbortTransaction ;
PROCEDURE BeginTransaction ;
PROCEDURE ClearLocking;
PROCEDURE EndTransaction;
PROCEDURE SetNoWaitLocking;
PROCEDURE SetWaitLocking;
PROCEDURE Unlock(File: BtrvFile);
(*_______________________________________________________________________
P R O C E D U R E S T O O P E R A T E O N R E C O R D S
_______________________________________________________________________*)
PROCEDURE Delete(File: BtrvFile;VAR Data: DataInfo);
PROCEDURE GetDirect(File: BtrvFile; RecAdr : PhysRecAdr;VAR Data: DataInfo);
PROCEDURE GetRecord(File: BtrvFile;VAR Data: DataInfo; RelOp: RelationalOp);
PROCEDURE GetKey(File: BtrvFile;VAR Data: DataInfo; RelOp: RelationalOp);
PROCEDURE GetPosition(File: BtrvFile): PhysRecAdr;
PROCEDURE Insert(File: BtrvFile; Data: DataInfo);
PROCEDURE StepDirect(File: BtrvFile;VAR Data: DataInfo);
PROCEDURE Update(File: BtrvFile; Data: DataInfo);
END Btrieve.
#################### SOURCES: IMPLEMENTATION MODULES ####################
IMPLEMENTATION MODULE CopyMem;
(*==========================================================================
Global Description : This module implements procedures to copy
unstructured data.
________________________________________________________________________
FirstEdit: 20/05/87
LastEdit : 26/06/87
________________________________________________________________________
Author : Marc Benveniste
System : Logitech MODULA-2/86 V. 2.05
Developped while
working at : IIMAS-UNAM,
Apdo. Postal 20-726,
Mexico D.F., 01000
MEXICO
===========================================================================*)
FROM SYSTEM IMPORT
(* Type *) ADDRESS;
PROCEDURE CopyByte(From, To: ADDRESS; ByteNum: ByteRange);
VAR
Src,Dst : POINTER TO ARRAY ByteRange OF CHAR;
i : CARDINAL;
BEGIN
Src := From;
Dst := To;
IF ByteNum > 0
THEN
FOR i := 0 TO ByteNum - 1 DO
Dst^[i] := Src^[i]
END (* for *)
END (* if *)
END CopyByte;
PROCEDURE CopyWord(From, To: ADDRESS; WordNum: WordRange);
VAR
Src,Dst : POINTER TO ARRAY WordRange OF CARDINAL;
i : CARDINAL;
BEGIN
Src := From;
Dst := To;
IF WordNum > 0
THEN
FOR i := 0 TO WordNum - 1 DO
Dst^[i] := Src^[i]
END (* for *)
END (* if *)
END CopyWord;
PROCEDURE FillByte(B: CHAR; To: ADDRESS; ByteNum: ByteRange);
VAR
Dst : POINTER TO ARRAY ByteRange OF CHAR;
i : CARDINAL;
BEGIN
Dst := To;
IF ByteNum > 0
THEN
FOR i := 0 TO ByteNum - 1 DO
Dst^[i] := B
END (* for *)
END (* if *)
END FillByte;
PROCEDURE FillWord(C: CARDINAL; To: ADDRESS; WordNum: WordRange);
VAR
Dst : POINTER TO ARRAY WordRange OF CARDINAL;
i : CARDINAL;
BEGIN
Dst := To;
IF WordNum > 0
THEN
FOR i := 0 TO WordNum - 1 DO
Dst^[i] := C
END (* for *)
END (* if *)
END FillWord;
END CopyMem.
IMPLEMENTATION MODULE Lists;
(*==========================================================================
Global Description : This module implements generic linked lists
________________________________________________________________________
FirstEdit: 18/05/87
LastEdit : 15/01/88
________________________________________________________________________
Author : Marc Benveniste
System : Logitech MODULA-2/86 V. 2.05
Developped while
working at : IIMAS-UNAM,
Apdo. Postal 20-726,
Mexico D.F., 01000
MEXICO
===========================================================================*)
FROM SYSTEM IMPORT
(* Type *) ADDRESS, WORD,
(* Procedure *) TSIZE;
FROM Storage IMPORT
(* Procedure *) ALLOCATE, DEALLOCATE, Available;
FROM CopyMem IMPORT
(* Procedure *) CopyByte, CopyWord;
TYPE
List = POINTER TO Descriptor;
Link = POINTER TO Node;
Descriptor = RECORD
IOBuffer : ADDRESS; (* Port to List *)
TSize : CARDINAL; (* Size of Elements *)
WordUnits : BOOLEAN; (* T if Word; F if Bytes *)
Head,PreCur, (* Head, Precurrent & Current *)
Current : Link (* elements of List *)
END;
Node = RECORD
Elem : ADDRESS; (* Ptr to Copy of Elem *)
Next : Link
END;
PROCEDURE NewList(IOPort: ADDRESS; ElemTypeSize: CARDINAL): List;
VAR
L : List;
A : BITSET;
BEGIN
IF Available(TSIZE(Descriptor))
THEN
ListError := 0;
A := BITSET(ElemTypeSize);
NEW(L);
WITH L^ DO
IOBuffer := IOPort;
IF (0 IN A)
THEN TSize := ElemTypeSize; WordUnits := FALSE
ELSE TSize := ElemTypeSize DIV 2; WordUnits := TRUE
END;
Head := NIL;
PreCur := NIL;
Current := NIL
END; (* with *)
RETURN L
END; (* if *)
ListError := 2;
RETURN NIL
END NewList;
PROCEDURE IsEmpty(VAR L : List): BOOLEAN;
BEGIN
IF L = NIL
THEN
ListError := 1;
RETURN FALSE
ELSE
ListError := 0;
RETURN (L^.Head = NIL)
END (* if *)
END IsEmpty;
PROCEDURE First(VAR L: List);
BEGIN
ListError := 0;
IF L = NIL
THEN ListError := 1
ELSIF L^.Head = NIL
THEN ListError := 3
ELSIF L^.WordUnits
THEN CopyWord(L^.Head^.Elem,L^.IOBuffer,L^.TSize)
ELSE CopyByte(L^.Head^.Elem,L^.IOBuffer,L^.TSize)
END; (*if*)
IF ListError = 0
THEN
WITH L^ DO
Current := Head;
PreCur := Head
END (* with *)
END (* if *)
END First;
PROCEDURE Insert(VAR L: List);
VAR
p : Link;
BEGIN
ListError := 0;
IF L = NIL
THEN ListError := 1;
ELSIF L^.WordUnits & Available(TSIZE(Node) + L^.TSize*2)
THEN
NEW(p);
ALLOCATE(p^.Elem,L^.TSize*2);
CopyWord(L^.IOBuffer,p^.Elem,L^.TSize)
ELSIF NOT(L^.WordUnits) & Available(TSIZE(Node) + L^.TSize)
THEN
NEW(p);
ALLOCATE(p^.Elem,L^.TSize);
CopyByte(L^.IOBuffer,p^.Elem,L^.TSize)
ELSE
ListError := 2
END; (*if*)
IF ListError = 0
THEN
IF L^.Head = L^.Current
THEN
WITH L^ DO
Current := p;
Current^.Next := Head;
Head := Current;
PreCur := Head
END (* with *)
ELSE
p^.Next := L^.Current;
L^.Current := p;
L^.PreCur^.Next := L^.Current
END (* if *)
END (* if *)
END Insert;
PROCEDURE Remove(VAR L: List);
VAR
p : Link;
BEGIN
IF L = NIL
THEN ListError := 1
ELSIF L^.Current = NIL
THEN ListError := 3
ELSE
p := L^.Current;
WITH L^ DO
IF Head = Current
THEN
Head := Current^.Next;
Current := Head;
PreCur := Head
ELSE
Current := Current^.Next;
PreCur^.Next := Current
END (* if *)
END; (* with *)
IF L^.Current = NIL
THEN
ListError := 5
ELSE
ListError := 0;
WITH L^ DO
IF WordUnits
THEN CopyWord(Current^.Elem,IOBuffer,TSize)
ELSE CopyByte(Current^.Elem,IOBuffer,TSize)
END
END
END; (* if *)
IF L^.WordUnits
THEN DEALLOCATE(p^.Elem,L^.TSize*2)
ELSE DEALLOCATE(p^.Elem,L^.TSize)
END;
DISPOSE(p)
END (* if *)
END Remove;
PROCEDURE Next(VAR L: List);
BEGIN
IF L = NIL
THEN ListError := 1
ELSIF (L^.Current = NIL) OR (L^.Current^.Next = NIL)
THEN ListError := 5
ELSE
ListError := 0;
WITH L^ DO
PreCur := Current;
Current := Current^.Next;
IF WordUnits
THEN CopyWord(Current^.Elem,IOBuffer,TSize)
ELSE CopyByte(Current^.Elem,IOBuffer,TSize)
END
END (* with *)
END (* if *)
END Next;
PROCEDURE Dispose(VAR L: List);
BEGIN
IF L = NIL
THEN ListError := 1
ELSIF L^.Head # NIL
THEN ListError := 4
ELSE
ListError := 0;
DISPOSE(L);
L := NIL
END (* if *)
END Dispose;
BEGIN
ListError := 0
END Lists.
IMPLEMENTATION MODULE Btrieve;
(*==========================================================================
Global Description : This module implements the MODULA-2/86 interface
to SoftCraft Btrieve version 4.04.
________________________________________________________________________
FirstEdit: 17/03/87
LastEdit : 30/09/87
________________________________________________________________________
Author : Marc Benveniste
System : Logitech MODULA-2/86 V. 2.05
Developped while
working at : IIMAS-UNAM,
Apdo. Postal 20-726,
Mexico D.F., 01000
MEXICO
===========================================================================*)
FROM SYSTEM IMPORT
(* Type *) ADDRESS,BYTE,WORD,
(* Procedure *) CODE,SWI,SETREG,GETREG,ADR,TSIZE,SIZE,
(* Const *) AX,BX,DX,DS;
FROM Storage IMPORT
(* Procedure *) Available, ALLOCATE, DEALLOCATE;
FROM CopyMem IMPORT
(* Procedure *) CopyWord;
IMPORT Lists;
FROM Lists IMPORT
(* Type *) List,
(* Var *) ListError,
(* Procedure *) NewList, IsEmpty, First, Remove, Dispose;
CONST
Mod2Id = 1111h; (* Modula-2 Language id*)
VarId = 6176h; (* Variable Length records Id -'va' *)
MultiFunction = 0abh * 256;
MultiLoad = MultiFunction + 4dh;
ProcIdGiven = 2;
BMultiParam = ProcIdGiven + MultiFunction;
TYPE
BtrvFile = POINTER TO PosBlock ;
PosBlock = ARRAY[0 .. 127] OF CHAR;
PhysRecAdr = ADDRESS;
BtrvParams = RECORD
BufAdr : ADDRESS;
BufLth : CARDINAL;
CurAdr : ADDRESS;
FCBAdr : ADDRESS;
FunCode : CARDINAL;
KeyAdr : ADDRESS;
KeyLth : BYTE;
UserKey : BYTE;
StatAdr : ADDRESS;
IntFaceId : INTEGER;
END ;
CallType = PROCEDURE(ADDRESS);
LockType = (NoLock,Wait,NoWait);
VAR
ProcId : INTEGER;
LockStat : LockType;
Param : BtrvParams ;
ParamAdr : ADDRESS;
BtrvCallProc : CallType;
FileRecordSize : CARDINAL;
(* Btrieve Call Interface *)
PROCEDURE SingleUser(A: ADDRESS);
BEGIN
CODE(1eh,16h,06h,55h); (* PUSH DS,SS,ES,BP *)
SETREG(DX,A.OFFSET);
SETREG(DS,A.SEGMENT);
SWI(07bh);
CODE(5dh,07h,17h,1fh); (* POP BP,ES,SS,DS *)
END SingleUser;
PROCEDURE MultiUser(A: ADDRESS);
VAR
ProcIdAux : INTEGER;
CallProcessed : CARDINAL;
AXReg : CARDINAL;
BEGIN
AXReg := BMultiParam;
ProcIdAux := ProcId;
REPEAT
CODE(1eh,16h,06h,55h); (* PUSH DS,SS,ES,BP *)
SETREG(AX,AXReg);
SETREG(BX,ProcIdAux);
SETREG(DX,A.OFFSET);
SETREG(DS,A.SEGMENT);
SWI(02fh);
CODE(5dh,07h,17h,1fh); (* POP BP,ES,SS,DS *)
GETREG(AX,CallProcessed);
IF (CallProcessed # 0)
THEN SETREG(AX,0200h);
SWI(07fh);
END;
UNTIL (CallProcessed = 0);
END MultiUser;
PROCEDURE Dummy(A : ADDRESS);
BEGIN
Status := 20
END Dummy;
(* Procedure for general Initialization *)
PROCEDURE Init;
CONST
MSDOSCall = 21h;
GetIntrVect = 357bh;
GetDOSVer = 3000h;
BtrvInstalled = 0033h;
ProcIdNotGiven = 1;
VAR
A : ADDRESS;
AXReg : CARDINAL;
ALReg : BYTE;
ProcIdAux : INTEGER;
CallProcessed : CARDINAL;
BEGIN
Status := 0;
ProcId := 0;
LockStat := NoLock;
ParamAdr := ADR(Param);
FileRecordSize := TSIZE(PosBlock);
StructList := NewList(ADR(FileStruct),SIZE(FileStruct));
WITH Param DO
StatAdr := ADR(Status);
IntFaceId := VarId;
END;
BtrvCallProc := Dummy;
SETREG(AX,GetIntrVect);
CODE(06h); (* PUSH ES *)
SWI(MSDOSCall);
CODE(07h); (* POP ES *)
GETREG(BX,AXReg);
IF (AXReg = BtrvInstalled)
THEN SETREG(AX,GetDOSVer);
CODE(06h); SWI(MSDOSCall); CODE(07h);
GETREG(AX,AXReg);
ALReg := VAL(BYTE,AXReg);
IF (ORD(ALReg) >= 3)
THEN SETREG(AX,MultiFunction);
SWI(02fh);
GETREG(AX,AXReg);
IF (AXReg = MultiLoad)
THEN BtrvCallProc := MultiUser;
(* Call a dummy Reset to initialize BtrvMulti and get *)
(* a Process Identifier that will remain unchanged. *)
Param.FunCode := 28;
Param.UserKey := VAL(BYTE,0);
A := ADR(Param);
AXReg := ProcIdNotGiven + MultiFunction;
ProcIdAux := ProcId;
REPEAT
CODE(1eh,16h,06h,55h); (* PUSH DS,SS,ES,BP *)
SETREG(AX,AXReg);
SETREG(BX,ProcIdAux);
SETREG(DX,A.OFFSET);
SETREG(DS,A.SEGMENT);
SWI(02fh);
CODE(5dh,07h,17h,1fh); (* POP BP,ES,SS,DS *)
GETREG(AX,CallProcessed);
GETREG(BX,ProcIdAux);
IF (CallProcessed # 0)
THEN SETREG(AX,0200h);
SWI(07fh);
END;
UNTIL (CallProcessed = 0);
ProcId := ProcIdAux;
ELSE BtrvCallProc := SingleUser;
END;
ELSE BtrvCallProc := SingleUser;
END;
END;
IF ListError # 0 THEN Status := 1 END
END Init;
(* MISCELLANEOUS PROCEDURES *)
PROCEDURE MakeRecord(AltCol: OrderStruct;VAR MemAllo: CARDINAL): ADDRESS;
CONST
SpecRecordSize = 16;
NULL = 00h;
VAR
RecordNum : CARDINAL;
SpecPtr : ADDRESS;
Q : ADDRESS;
KeyFlag : BITSET;
Reserved : CARDINAL;
BEGIN
Reserved := NULL;
First(StructList);
RecordNum := 0;
WHILE ListError = 0 DO
INC(RecordNum);
Lists.Next(StructList)
END; (* while *)
MemAllo := RecordNum * SpecRecordSize;
IF AltCol.Exists THEN INC(MemAllo,265) END;
IF Available(MemAllo)
THEN
ALLOCATE(SpecPtr,MemAllo);
(* FileSpec *)
First(StructList); Q := SpecPtr;
Q^ := WORD(FileStruct.RecordLgth); INC(Q,2);
Q^ := WORD(FileStruct.PageSizeMult * PageSizeUnit); INC(Q,2);
Q^ := WORD(FileStruct.IndexesNum); INC(Q,2);
Q^ := WORD(Reserved) ; INC(Q,2);
Q^ := WORD(Reserved) ; INC(Q,2);
IF FileStruct.VarLgthRec THEN Q^ := WORD(1)
ELSE Q^ := WORD(NULL)
END; INC(Q,2);
Q^ := WORD(Reserved) ; INC(Q,2);
Q^ := WORD(Reserved); INC(Q,2);
(* KeySpec *)
WHILE ListError = 0 DO
KeyFlag := {};
Lists.Next(StructList);
Q^ := WORD(FileStruct.KeyPos); INC(Q,2);
Q^ := WORD(FileStruct.KeyLgth); INC(Q,2);
IF FileStruct.Segmented THEN INCL(KeyFlag,4) END;
IF FileStruct.Duplicates THEN INCL(KeyFlag,0) END;
IF FileStruct.Modifiable THEN INCL(KeyFlag,1) END;
IF FileStruct.Binary
THEN INCL(KeyFlag,2)
ELSIF FileStruct.AltColSeq
THEN INCL(KeyFlag,5)
END; (* if *)
INC(Q,6);
IF FileStruct.NullKey
THEN Q^ := WORD(ORD(FileStruct.NullChar)*256); INCL(KeyFlag,3)
ELSE Q^ := WORD(Reserved)
END; (* if *)
DEC(Q,6);
Q^ := WORD(KeyFlag); INC(Q,2);
Q^ := WORD(Reserved); INC(Q,2);
Q^ := WORD(Reserved); INC(Q,4);
Q^ := WORD(Reserved); INC(Q,2);
Q^ := WORD(Reserved); INC(Q,2)
END; (* while *)
(* AltColSpec *)
IF AltCol.Exists
THEN
Q^ := WORD(0ac00h); INC(Q);
CopyWord(ADR(AltCol.Name),Q,132)
END; (* if *)
RETURN SpecPtr
ELSE
RETURN NIL
END; (* if *)
END MakeRecord;
PROCEDURE MakeStruct(Q: ADDRESS;VAR AltCol : OrderStruct;
VAR RecNum: LongCard; VAR Freq: RecsPerKey);
VAR
DefKeys : CARDINAL;
Index : KeyNum;
KeyFlag : BITSET;
OK : BOOLEAN;
BEGIN
First(StructList);
WHILE ListError = 0 DO Remove(StructList) END;
Lists.Insert(StructList); (* Dummy last *)
FileStruct.Spec := FileSpec;
FileStruct.RecordLgth := CARDINAL(Q^); INC(Q,2);
FileStruct.PageSizeMult := CARDINAL(Q^) DIV PageSizeUnit; INC(Q,2);
FileStruct.IndexesNum := CARDINAL(Q^); INC(Q,2);
RecNum.Low := CARDINAL(Q^); INC(Q,2);
RecNum.High := CARDINAL(Q^); INC(Q,2);
FileStruct.VarLgthRec := (CARDINAL(Q^) = 1); INC(Q,6);
DefKeys := FileStruct.IndexesNum - 1;
Lists.Insert(StructList);
OK := (ListError = 0);
Lists.Next(StructList);
Index := 0;
WHILE (Index <= DefKeys) & OK DO
WITH FileStruct DO
Spec := KeySpec;
KeyPos := CARDINAL(Q^); INC(Q,2);
KeyLgth := CARDINAL(Q^); INC(Q,2)
END; (* with *)
KeyFlag := BITSET(Q^); INC(Q,6);
WITH FileStruct DO
Duplicates := (0 IN KeyFlag);
Modifiable := (1 IN KeyFlag);
Segmented := (4 IN KeyFlag);
NullKey := (3 IN KeyFlag);
IF NullKey THEN NullChar := CHR(CARDINAL(Q^) DIV 256) END;
Binary := (2 IN KeyFlag);
IF NOT(Binary) THEN AltColSeq := (5 IN KeyFlag) END
END; (* with *)
INC(Q,6);
IF (NOT(FileStruct.Binary) & FileStruct.AltColSeq)
THEN AltCol.Exists := TRUE
END; (* if *)
IF NOT(FileStruct.Segmented)
THEN
DEC(Q,10);
Freq[Index].Low := CARDINAL(Q^); INC(Q,2);
Freq[Index].High := CARDINAL(Q^); INC(Q,8);
INC(Index)
END; (* if *)
Lists.Insert(StructList);
OK := (ListError = 0);
Lists.Next(StructList)
END; (* while *)
Remove(StructList); (* Remove dummy last inserted before loop *)
FOR Index := DefKeys + 1 TO MaxKeyNum - 1 DO
Freq[Index].Low := 0;
Freq[Index].High := 0
END; (* for *)
IF NOT OK
THEN
First(StructList);
WHILE ListError = 0 DO Remove(StructList) END;
AltCol.Exists := FALSE
ELSIF AltCol.Exists
THEN
INC(Q);
CopyWord(Q,ADR(AltCol.Name),132)
END (* if *)
END MakeStruct;
(* PROCEDURES TO MANAGE THE SYSTEM *)
PROCEDURE GetDirectory(Drv: LogicalDrive;VAR DirPath: ARRAY OF CHAR);
BEGIN
IF (HIGH(DirPath) >= 64)
THEN
WITH Param DO
FunCode := 18;
KeyAdr := ADR(DirPath);
KeyLth := VAL(BYTE,HIGH(DirPath));
UserKey := VAL(BYTE,ORD(Drv))
END; (* with *)
BtrvCallProc(ParamAdr)
ELSE
Status := 21
END (* if *)
END GetDirectory;
PROCEDURE Reset(OwnStation: BOOLEAN; VAR OtherInfo: ARRAY OF CHAR);
BEGIN
WITH Param DO
FunCode := 28;
KeyAdr := ADR(OtherInfo);
KeyLth := VAL(BYTE, HIGH(OtherInfo));
IF NOT(OwnStation)
THEN UserKey := VAL(BYTE,-1)
ELSE UserKey := VAL(BYTE,0)
END (* if *)
END; (* with *)
BtrvCallProc(ParamAdr)
END Reset;
PROCEDURE SetDirectory(DirPath: ARRAY OF CHAR);
BEGIN
WITH Param DO
FunCode := 17;
KeyAdr := ADR(DirPath);
KeyLth := VAL(BYTE,HIGH(DirPath))
END; (* with *)
BtrvCallProc(ParamAdr)
END SetDirectory;
PROCEDURE Stop;
BEGIN
Param.FunCode := 25;
BtrvCallProc(ParamAdr);
IF (Status = 0) THEN BtrvCallProc := Dummy END;
First(StructList);
WHILE ListError = 0 DO Remove(StructList) END;
Dispose(StructList)
END Stop;
PROCEDURE Version(VAR VerNum,RevNum: CARDINAL; VAR Slash: CHAR);
TYPE
SysInfo = RECORD
V,R : CARDINAL;
S : CHAR
END;
VAR
Present : SysInfo;
BEGIN
WITH Present DO
V := VerNum;
R := RevNum;
S := Slash
END; (* with *)
WITH Param DO
BufAdr := ADR(Present);
BufLth := TSIZE(SysInfo);
FunCode := 26
END; (* with *)
BtrvCallProc(ParamAdr);
VerNum := Present.V;
RevNum := Present.R;
Slash := Present.S
END Version;
(* PROCEDURES TO MANAGE THE FILES *)
PROCEDURE ClearOwner(File : BtrvFile);
BEGIN
IF File # NIL
THEN
WITH Param DO
FCBAdr := File;
CurAdr := FCBAdr; INC(CurAdr,38);
FunCode := 30;
END (* with *);
BtrvCallProc(ParamAdr)
ELSE
Status := 3
END (* if *)
END ClearOwner;
PROCEDURE Close(VAR File : BtrvFile);
BEGIN
IF File # NIL
THEN
WITH Param DO
FCBAdr := File;
CurAdr := FCBAdr; INC(CurAdr,38);
FunCode := 1;
END (* with *);
BtrvCallProc(ParamAdr);
IF (Status = 0) THEN DISPOSE(File) END (* if *)
ELSE
Status := 3
END (* if *)
END Close;
PROCEDURE Create(FileName : ARRAY OF CHAR; VAR AltColSeq : OrderStruct);
VAR
Dum0 : ARRAY[0 .. 127] OF CHAR;
MemAllo : CARDINAL;
Q : ADDRESS;
BEGIN
Q := MakeRecord(AltColSeq,MemAllo);
IF (Q = NIL)
THEN Status := 1
ELSE
WITH Param DO
BufAdr := Q;
BufLth := MemAllo;
FCBAdr := ADR(Dum0);
CurAdr := FCBAdr; INC(CurAdr,38);
FunCode := 14;
KeyAdr := ADR(FileName);
KeyLth := VAL(BYTE,HIGH(FileName))
END; (* with *)
BtrvCallProc(ParamAdr);
DEALLOCATE(Q,MemAllo)
END (* if *)
END Create;
PROCEDURE Extend(File: BtrvFile; FileName: ARRAY OF CHAR; Now: BOOLEAN);
BEGIN
IF File # NIL
THEN
WITH Param DO
FCBAdr := File;
CurAdr := FCBAdr; INC(CurAdr,38);
FunCode := 16;
KeyAdr := ADR(FileName);
KeyLth := VAL(BYTE,HIGH(FileName));
IF Now THEN UserKey := VAL(BYTE,-1) ELSE UserKey := VAL(BYTE,0) END
END; (* with *)
BtrvCallProc(ParamAdr)
ELSE
Status := 3
END (* if *)
END Extend;
PROCEDURE Open(FileName: ARRAY OF CHAR; Owner : OwnerName;
Mode : OpeningMode ): BtrvFile;
VAR
Created : BtrvFile;
BEGIN
IF NOT(Available(FileRecordSize))
THEN
Status := 1;
RETURN NIL
END; (* if *)
NEW(Created);
WITH Param DO
BufAdr := ADR(Owner);
BufLth := HIGH(Owner);
FCBAdr := Created;
CurAdr := FCBAdr; INC(CurAdr,38);
FunCode := 0;
KeyAdr := ADR(FileName);
KeyLth := VAL(BYTE, HIGH(FileName));
UserKey := VAL(BYTE, INTEGER(ORD(Mode))-3)
END; (* with *)
BtrvCallProc(ParamAdr);
IF (Status # 0) THEN RETURN NIL END; (* if *)
RETURN Created
END Open;
PROCEDURE SetOwner(File: BtrvFile; Owner: OwnerName;
AnyAccess, Encryption:BOOLEAN );
VAR
Dum : CARDINAL;
BEGIN
IF File # NIL
THEN
Dum := 0;
IF NOT(AnyAccess) THEN Dum := 1 END;
IF Encryption THEN INC(Dum,2) END;
WITH Param DO
BufAdr := ADR(Owner);
BufLth := 9;
FCBAdr := File;
CurAdr := FCBAdr; INC(CurAdr,38);
FunCode := 29;
KeyAdr := BufAdr;
KeyLth := VAL(BYTE,BufLth);
UserKey := VAL(BYTE,Dum)
END; (* with *)
BtrvCallProc(ParamAdr)
ELSE
Status := 3
END (* if *)
END SetOwner;
PROCEDURE Stat(File: BtrvFile; VAR RecNum: LongCard;VAR Freq: RecsPerKey;
VAR AltColSeq: OrderStruct; VAR ExtFileName: ARRAY OF CHAR);
CONST
SpecRecordSize = 16;
MemAllo = SpecRecordSize*(MaxKeyNum + 1) + 265;
VAR
Q : ADDRESS;
BEGIN
IF File = NIL
THEN
Status := 3
ELSIF Available(MemAllo)
THEN
ALLOCATE(Q,MemAllo);
WITH Param DO
BufAdr := Q;
BufLth := MemAllo;
FCBAdr := File;
CurAdr := FCBAdr; INC(CurAdr,38);
FunCode := 15;
KeyAdr := ADR(ExtFileName);
KeyLth := VAL(BYTE, HIGH(ExtFileName))
END; (* with *)
BtrvCallProc(ParamAdr);
IF (Status = 0)
THEN
MakeStruct(Q,AltColSeq,RecNum,Freq)
ELSE
First(StructList);
WHILE ListError = 0 DO Remove(StructList) END;
AltColSeq.Exists := FALSE
END; (* if *)
DEALLOCATE(Q,MemAllo);
ELSE
Status := 1
END (* if *)
END Stat;
(* PROCEDURES TO MANAGE OPERATIONS *)
PROCEDURE AbortTransaction ;
BEGIN
Param.FunCode := 21;
BtrvCallProc(ParamAdr)
END AbortTransaction ;
PROCEDURE BeginTransaction ;
BEGIN
IF (LockStat = NoWait) THEN Param.FunCode := 219 ELSE Param.FunCode := 19 END;
BtrvCallProc(ParamAdr)
END BeginTransaction ;
PROCEDURE ClearLocking;
BEGIN
LockStat := NoLock
END ClearLocking;
PROCEDURE EndTransaction;
BEGIN
Param.FunCode := 20;
BtrvCallProc(ParamAdr)
END EndTransaction;
PROCEDURE SetWaitLocking;
BEGIN
LockStat := Wait
END SetWaitLocking;
PROCEDURE SetNoWaitLocking;
BEGIN
LockStat := NoWait
END SetNoWaitLocking;
PROCEDURE Unlock(File: BtrvFile);
BEGIN
IF File # NIL
THEN
WITH Param DO
FCBAdr := File;
CurAdr := FCBAdr; INC(CurAdr,38);
FunCode := 27
END; (* with *)
BtrvCallProc(ParamAdr)
ELSE
Status := 3
END (* if *)
END Unlock;
(* PROCEDURES TO OPERATE ON RECORDS *)
PROCEDURE Delete(File: BtrvFile;VAR Data: DataInfo);
BEGIN
IF File # NIL
THEN
WITH Param DO
BufAdr := Data.DataBufAdr;
BufLth := Data.DataBufLth;
FCBAdr := File;
CurAdr := FCBAdr; INC(CurAdr,38);
FunCode := 4;
KeyAdr := Data.KeyBufAdr;
UserKey := VAL(BYTE,Data.Key^);
KeyLth := VAL(BYTE,Data.KeyBufLth)
END; (* with *)
BtrvCallProc(ParamAdr)
ELSE
Status := 3
END (* if *)
END Delete;
PROCEDURE GetDirect(File: BtrvFile; RecAdr : PhysRecAdr;VAR Data: DataInfo);
BEGIN
IF File # NIL
THEN
CopyWord(ADR(RecAdr),Data.DataBufAdr,2);
WITH Param DO
BufAdr := Data.DataBufAdr;
BufLth := Data.DataBufLth;
FCBAdr := File;
CurAdr := FCBAdr; INC(CurAdr,38);
FunCode := 23 + 100*ORD(LockStat);
KeyAdr := Data.KeyBufAdr;
KeyLth := VAL(BYTE,Data.KeyBufLth);
UserKey := VAL(BYTE,Data.Key^)
END; (* with *)
BtrvCallProc(ParamAdr);
Data.DataBufLth := Param.BufLth
ELSE
Status := 3
END (* if *)
END GetDirect;
PROCEDURE GetRecord(File: BtrvFile;VAR Data: DataInfo; RelOp: RelationalOp);
BEGIN
IF File # NIL
THEN
WITH Param DO
BufAdr := Data.DataBufAdr;
BufLth := Data.DataBufLth;
FCBAdr := File;
CurAdr := FCBAdr; INC(CurAdr,38);
FunCode := 5 + ORD(RelOp) + 100*ORD(LockStat);
KeyAdr := Data.KeyBufAdr;
KeyLth := VAL(BYTE,Data.KeyBufLth);
UserKey := VAL(BYTE,Data.Key^)
END; (* with *)
BtrvCallProc(ParamAdr);
Data.DataBufLth := Param.BufLth
ELSE
Status := 3
END (* if *)
END GetRecord;
PROCEDURE GetKey(File: BtrvFile;VAR Data: DataInfo; RelOp: RelationalOp);
BEGIN
IF File # NIL
THEN
WITH Param DO
BufAdr := Data.DataBufAdr;
BufLth := Data.DataBufLth;
FCBAdr := File;
CurAdr := FCBAdr; INC(CurAdr,38);
FunCode := 55 + ORD(RelOp);
KeyAdr := Data.KeyBufAdr;
KeyLth := VAL(BYTE,Data.KeyBufLth);
UserKey := VAL(BYTE,Data.Key^)
END; (* with *)
BtrvCallProc(ParamAdr)
ELSE
Status := 3
END (* if *)
END GetKey;
PROCEDURE GetPosition(File: BtrvFile): PhysRecAdr;
VAR
Aux : PhysRecAdr;
BEGIN
IF File # NIL
THEN
WITH Param DO
BufAdr := ADR(Aux);
BufLth := TSIZE(PhysRecAdr);
FCBAdr := File;
CurAdr := FCBAdr; INC(CurAdr,38);
FunCode := 22
END; (* with *)
BtrvCallProc(ParamAdr);
RETURN Aux
ELSE
Status := 3
END (* if *)
END GetPosition;
PROCEDURE Insert(File: BtrvFile; Data: DataInfo);
BEGIN
IF File # NIL
THEN
WITH Param DO
BufAdr := Data.DataBufAdr;
BufLth := Data.DataBufLth;
FCBAdr := File;
CurAdr := FCBAdr; INC(CurAdr,38);
FunCode := 2;
KeyAdr := Data.KeyBufAdr;
KeyLth := VAL(BYTE,Data.KeyBufLth);
UserKey := VAL(BYTE,Data.Key^)
END; (* with *)
BtrvCallProc(ParamAdr)
ELSE
Status := 3
END (* if *)
END Insert;
PROCEDURE StepDirect(File: BtrvFile; VAR Data: DataInfo);
BEGIN
IF File # NIL
THEN
WITH Param DO
BufAdr := Data.DataBufAdr;
BufLth := Data.DataBufLth;
FCBAdr := File;
CurAdr := FCBAdr; INC(CurAdr,38);
FunCode := 24 + 100*ORD(LockStat)
END; (* with *)
BtrvCallProc(ParamAdr);
Data.DataBufLth := Param.BufLth
ELSE
Status := 3
END (* if *)
END StepDirect;
PROCEDURE Update(File: BtrvFile; Data: DataInfo);
BEGIN
IF File # NIL
THEN
WITH Param DO
BufAdr := Data.DataBufAdr;
BufLth := Data.DataBufLth;
FCBAdr := File;
CurAdr := FCBAdr; INC(CurAdr,38);
FunCode := 3;
KeyAdr := Data.KeyBufAdr;
KeyLth := VAL(BYTE,Data.KeyBufLth);
UserKey := VAL(BYTE,Data.Key^)
END; (* with *)
BtrvCallProc(ParamAdr)
ELSE
Status := 3
END (* if *)
END Update;
(* Main initializing code *)
BEGIN
Init
END Btrieve.