Category : Modula II Source Code
Archive   : JPIBTRV.ZIP
Filename : MOD2BTRV.MOD

 
Output of file : MOD2BTRV.MOD contained in archive : JPIBTRV.ZIP
(* *)
(* Module Name: Mod2Btrv.MOD *)
(* *)
(* Description: This is the Btrieve interface for JPI TopSpeed Modula-2. *)
(* This routine sets up the parameter block expected by *)
(* Btrieve, and issues interrupt 7B. It was created from *)
(* the TURXBTRV interface. *)
(* *)
(* Synopsis: STAT := BTRV (OP, POS.START, DATA.START, DATALEN, *)
(* KBUF.START, KEY); *)
(* where *)
(* OP is an integer, *)
(* POS is a 128 byte array, *)
(* DATA is an untyped parameter for the data buffer, *)
(* DATALEN is the integer length of the data buffer, *)
(* KBUF is the untyped parameter for the key buffer, *)
(* and KEY is an integer. *)
(* *)
(* Returns: Btrieve status code (see Appendix B of the Btrieve Manual). *)
(* *)

IMPLEMENTATION MODULE Mod2BTRV;

FROM SYSTEM IMPORT Registers, Ofs, Seg;
FROM AsmLib IMPORT Intr;

PROCEDURE BTRV(OP: INTEGER;
VAR POS, DATA: ARRAY OF BYTE;
VAR DATALEN: INTEGER;
VAR KBUF: ARRAY OF BYTE;
KEY: INTEGER): INTEGER;


CONST
PASCALID = 0AAAAH; (*Pascal language id*)

VARID = 06176H; (*id for variable length records - 'va'*)

BTRINT = 07BH;
BTR2INT = 02FH;
BTROFFSET = 00033H;
MULTIFUNCTION = 0ABH;
(* ProcId is used for communicating with the Multi Tasking Version of *)
(* Btrieve. It contains the process id returned from BMulti and should *)
(* not be changed once it has been set. *)
(* *)

VAR
ProcId: INTEGER; (* initialize to no process id *)
MULTI: BOOLEAN; (* set to true if BMulti is loaded *)
VSet: BOOLEAN; (* set to true if we have checked for BMulti *)



TYPE

ADDR32 = RECORD (*32 bit address*)
OFFSET: INTEGER;
SEGMENT: INTEGER;
END;

BTRPARMS = RECORD
USERBUFADDR: ADDR32; (*data buffer address*)
USERBUFLEN: INTEGER; (*data buffer length*)
USERCURADDR: ADDR32; (*currency block address*)
USERFCBADDR: ADDR32; (*file control block address*)
USERFUNCTION: INTEGER; (*Btrieve operation*)
USERKEYADDR: ADDR32; (*key buffer address*)
USERKEYLENGTH: BYTE; (*key buffer length*)
USERKEYNUMBER: BYTE; (*key number*)
USERSTATADDR: ADDR32; (*return status address*)
XFACEID: INTEGER; (*language interface id*)
END;

Result = Registers;

VAR
STAT: INTEGER; (*Btrieve status code*)
XDATA: BTRPARMS; (*Btrieve parameter block*)
REGS: Result; (*register structure used on interrrupt call*)
DONE: BOOLEAN;
BTRVResult: INTEGER;

BEGIN
VSet := FALSE;
MULTI := FALSE;
ProcId := 0;
REGS.AX := 03500H+BTRINT;
Intr(REGS,021H);
IF (REGS.BX <> BTROFFSET) THEN (*make sure Btrieve is installed*)
STAT := 20
ELSE
IF (NOT VSet) THEN (*if we haven't checked for Multi-User version*)
REGS.AX := 03000H;
Intr(REGS,021H);
IF (CARDINAL(BITSET(REGS.AX) * BITSET(000FFH)) >= 3) THEN
VSet := TRUE;
REGS.AX := MULTIFUNCTION*256;
Intr(REGS, BTR2INT);
MULTI := (CARDINAL(BITSET(REGS.AX) * BITSET(000FFH)) = 0004DH);
ELSE
MULTI := FALSE
END;
END; (*make normal btrieve call*)
WITH XDATA DO
USERBUFADDR.SEGMENT := Seg(DATA);
USERBUFADDR.OFFSET := Ofs(DATA); (*set data buffer address*)
USERBUFLEN := DATALEN;
USERFCBADDR.SEGMENT := Seg(POS);
USERFCBADDR.OFFSET := Ofs(POS); (*set FCB address*)
USERCURADDR.SEGMENT := USERFCBADDR.SEGMENT; (*set cur seg*)
USERCURADDR.OFFSET := USERFCBADDR.OFFSET+38; (*set cur ofs*)
USERFUNCTION := OP; (*set Btrieve operation code*)
USERKEYADDR.SEGMENT := Seg(KBUF);
USERKEYADDR.OFFSET := Ofs(KBUF); (*set key buffer address*)
USERKEYLENGTH := BYTE(255); (*assume its large enough*)
USERKEYNUMBER := BYTE(KEY); (*set key number*)
USERSTATADDR.SEGMENT := Seg(STAT);
USERSTATADDR.OFFSET := Ofs(STAT); (*set status address*)
XFACEID := VARID; (*set language id*)
END;
REGS.DX := Ofs(XDATA);
REGS.DS := Seg(XDATA);
IF ( NOT MULTI) THEN (*MultiUser version not installed*)
Intr(REGS, BTRINT)
ELSE
DONE := FALSE;
REPEAT
REGS.BX := ProcId;
REGS.AX := 1;
IF (REGS.BX <> 0) THEN
REGS.AX := 2
END;
INC(REGS.AX, (MULTIFUNCTION*256));
Intr(REGS, BTRINT);
IF (CARDINAL(BITSET(REGS.AX) * BITSET(000FFH)) = 0) THEN
DONE := TRUE
ELSE
REGS.AX := 00200H;
Intr(REGS, 07FH);
DONE := FALSE;
END;
UNTIL (DONE);
IF (ProcId = 0) THEN
ProcId := REGS.BX
END;
END;
DATALEN := XDATA.USERBUFLEN;
END;
BTRVResult := STAT;
RETURN BTRVResult
END BTRV;
END Mod2BTRV.


  3 Responses to “Category : Modula II Source Code
Archive   : JPIBTRV.ZIP
Filename : MOD2BTRV.MOD

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/