home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a011 / 2.ddi / MODXBTRV.MOD < prev    next >
Encoding:
Modula Implementation  |  1986-06-09  |  5.5 KB  |  182 lines
  1. IMPLEMENTATION MODULE ModXBTRV;
  2. FROM SYSTEM IMPORT ADDRESS,WORD,BYTE,CODE,SWI,SETREG,GETREG,ADR,
  3.            AX,BX,DX,DS;
  4. (*                                          *)
  5. (*  Module Name: ModXBTRV.MOD                              *)
  6. (*                                          *)
  7. (*  Description: This is the Btrieve Version 4.0 interface for              *)
  8. (*         LogiTech Modula-2/86.    This routine sets up the          *)
  9. (*         parameter block expected by Btrieve, and issues          *)
  10. (*         interrupt 7B.                              *)
  11. (*                                          *)
  12. (*  Synopsis:     STAT := BTRV (OP, POS, DATA, DATALEN, KBUF,KEY)          *)
  13. (*                                          *)
  14. (*             where                              *)
  15. (*             OP is an integer                      *)
  16. (*             POS is the address to a 128 byte array,          *)
  17. (*             DATA is the address to a data structure          *)
  18. (*             DATALEN is a cardinal                      *)
  19. (*             KBUF is the address to a data structure          *)
  20. (*             and KEY is an integer.                      *)
  21. (*                                          *)
  22. (*  Returns:     Btrieve status code (see Appendix B of the Btrieve Manual).  *)
  23.  
  24. VAR
  25.  
  26. (*  ProcId is used for communicating with the Multi Tasking Version of          *)
  27. (*  Btrieve. It contains the process id returned from BMulti and should       *)
  28. (*  not be changed once it has been set.                      *)
  29. (*                                          *)
  30.  
  31.    ProcId:  INTEGER;
  32.    Vset:    BOOLEAN;
  33.    Wait:    BOOLEAN;
  34.    Multi:   BOOLEAN;
  35.  
  36. PROCEDURE BTRV (OP: CARDINAL; POS, DATA: ADDRESS; VAR DATALEN: CARDINAL;
  37.                 KBUF: ADDRESS; KEY: INTEGER): INTEGER;
  38. CONST
  39.      Mod2ID = 1111H;                       (* Modula-2 Language id*)
  40.      VarId = 6176H;            (*id for variable length records -'va'*)
  41.      MultiFunction = 0ABH * 256;
  42.      MultiLoad = MultiFunction + 4DH;
  43.  
  44. TYPE
  45.      BtrParms = RECORD
  46.     UserBufAddr:   ADDRESS;              (*data buffer address*)
  47.     UserBufLen:    CARDINAL;              (*data buffer length*)
  48.     UserCurAddr:   ADDRESS;               (*currency block address*)
  49.     UserFCBAddr:   ADDRESS;           (*file control block address*)
  50.     UserFunction:  CARDINAL;               (*Btrieve operation*)
  51.     UserKeyAddr:   ADDRESS;               (*key buffer address*)
  52.     UserKeyLength: CHAR;                   (*key buffer length*)
  53.     UserKeyNumber: BYTE;                      (*key number*)
  54.     UserStatAddr:  ADDRESS;                (*return status address*)
  55.     XFACEID:       INTEGER;                (*language interface id*)
  56.      END;
  57. VAR
  58.      Stat:  INTEGER;                     (*Btrieve status code*)
  59.      XDATA: BtrParms;                     (*Btrieve parameter block*)
  60.      A:     ADDRESS;
  61.      w:     WORD;
  62.      rAX:   CARDINAL;
  63.      I:     CARDINAL;
  64.      iBYTE: BYTE;
  65.      TempAX:INTEGER;
  66.      TempId:INTEGER;
  67.      Done:  BOOLEAN;
  68.  
  69. BEGIN
  70.      Done := FALSE;
  71.  
  72.      SETREG (AX,357BH);
  73.      CODE (06H);     (* push ES *)
  74.      SWI (021H);
  75.      CODE (07H);     (* pop ES *)
  76.      GETREG (BX, I);
  77.  
  78.      IF (I # 0033H) THEN
  79.     Stat := 20;
  80.      ELSE
  81.     IF NOT Vset THEN
  82.        Vset := TRUE;    (*Set flag indicating we know what version we have*)
  83.        SETREG (AX,3000H);
  84.        CODE (06H);    (* push ES *)
  85.        SWI (021H);
  86.        CODE (07H);    (* pop ES *)
  87.        GETREG (AX, I);
  88.        iBYTE := VAL(BYTE, I);
  89.        IF (ORD(iBYTE) >= 3) THEN
  90.           SETREG (AX, MultiFunction);
  91.           SWI (02FH);
  92.           GETREG (AX, I);
  93.           IF (I = MultiLoad) THEN
  94.          Multi := TRUE;               (*Multi user version*)
  95.           ELSE
  96.          Multi := FALSE;
  97.           END;
  98.        ELSE
  99.           Multi := FALSE;
  100.        END;
  101.     END;
  102.     WITH XDATA DO
  103.        UserBufAddr := DATA;              (*set data buffer address*)
  104.        UserBufLen := DATALEN;              (*use caller's value*)
  105.        UserFCBAddr := POS;                     (*set FCB address*)
  106.        UserCurAddr.SEGMENT := UserFCBAddr.SEGMENT;         (*set cur segment*)
  107.        UserCurAddr.OFFSET := UserFCBAddr.OFFSET+38;       (*set cur offset*)
  108.        UserFunction := OP;              (*set Btrieve operation code*)
  109.        UserKeyAddr := KBUF;               (*set key buffer address*)
  110.        UserKeyLength := CHR(255);             (*assume its large enough*)
  111.        UserKeyNumber := VAL (BYTE,KEY);              (*set key number*)
  112.        UserStatAddr := ADR (Stat);              (*set Status address*)
  113.        XFACEID := VarId;                     (*set language id*)
  114.     END;
  115.  
  116.     A := ADR (XDATA);
  117.  
  118.     IF (NOT Multi) THEN
  119.        CODE (1EH);       (* push DS *)
  120.        CODE (16H);       (* push SS *)
  121.        CODE (06H);       (* push ES *)
  122.        CODE (55H);       (* push BP *)
  123.        SETREG (DX,A.OFFSET);
  124.        SETREG (DS,A.SEGMENT);
  125.        SWI (07BH);
  126.        CODE (5DH);       (* pop BP *)
  127.        CODE (07H);       (* pop ES *)
  128.        CODE (17H);       (* pop SS *)
  129.        CODE (1FH);       (* pop DS *)
  130.     ELSE
  131.  
  132.        (* Set up parameters expected by BMulti                    *)
  133.  
  134.        IF (ProcId # 0) THEN           (* already have a process id? *)
  135.           rAX := 2;                 (* yes, let BMulti know *)
  136.        ELSE
  137.           rAX := 1;                 (* assume no process id *)
  138.        END;
  139.        rAX := rAX + MultiFunction;
  140.  
  141.     (*                                    *)
  142.     (*  Make call to the Btrieve Record Manager.                *)
  143.     (*                                    *)
  144.        REPEAT
  145.           CODE (1EH);     (* push DS *)
  146.           CODE (16H);     (* push SS *)
  147.           CODE (06H);     (* push ES *)
  148.           CODE (55H);     (* push BP *)
  149.           SETREG (AX,rAX);
  150.           SETREG (BX,ProcId);
  151.           SETREG (DX,A.OFFSET);
  152.           SETREG (DS,A.SEGMENT);
  153.  
  154.           SWI (02FH);
  155.  
  156.           CODE (5DH);     (* pop BP *)
  157.           CODE (07H);     (* pop ES *)
  158.           CODE (17H);     (* pop SS *)
  159.           CODE (1FH);     (* pop DS *)
  160.           GETREG (AX, I);
  161.           GETREG (BX,TempId);
  162.           IF (I # 0) THEN
  163.          SETREG (AX, 0200H);
  164.          SWI (07FH);
  165.           END;
  166.        UNTIL (I = 0);
  167.        IF (ProcId = 0) THEN
  168.           ProcId := TempId;
  169.        END;
  170.     END;
  171.     DATALEN := XDATA.UserBufLen;         (*retrieve return data length*)
  172.      END;
  173.      RETURN Stat;
  174.    END BTRV;
  175.  
  176. BEGIN
  177.       ProcId := 0;
  178.       Vset   := FALSE;
  179.       Wait   := FALSE;
  180.       Multi  := FALSE;
  181. END ModXBTRV.
  182.