* GET A DATABASE ADDRESS
D$       SETSTR   [.LEFT(.FILE,4)]
         INCLUDE  [D$]_QDOS_TRAP_IN
         INCLUDE  [D$]_QDOS_VECT_IN
         INCLUDE  [D$]_QDOS_DATA_IN
         INCLUDE  [D$]_DATA_IN
BV.CHBAS EQU      $30
BV.CHP   EQU      $34
BV.RIP   EQU      $58
BV.RIBAS EQU      $5C
BCH.DBAS EQU      $24
BCH.LEN  EQU      $28
         FILETYPE 0        FILE TYPE SETTING
*
         SECTION  MAIN
*
         LEA      PROCDEF(PC),A1
         MOVE.W   BP.INIT,A2
         JSR      (A2)
         MOVEQ    #0,D0
         RTS
* FUNCTION DEFINITION
PROCDEF  DC.W     0,0,1
         DC.W     DBADDR-*
         DC.B     6,'DBADDR'        DBADDR(#C)
         DC.W     0
* GET DATABASE ADDRESS FROM A SUPERBASIC CHANNEL BLOCK
DBADDR
         MOVEQ    #ERR.BP,D0
         SUBQ.L   #8,A5
         CMPA.L   A3,A5             IF NOT 1 PARAMETER, ERROR
         BNE.S    SPEC_ERR
         ADDQ.L   #8,A5             POINT TO ONLY PARAM
*
         BTST     #7,1(A6,A3.L)     MUST BE #C, ELSE ERROR
         BEQ.S    SPEC_ERR
         MOVE.W   CA.GTINT,A2       GET AN INTEGER
         JSR      (A2)
         BNE.S    SPEC_ERR
         MOVE.W   0(A6,A1.L),D1     GET THE CHANNEL NUMBER
         ADDQ.L   #2,BV.RIP(A6)
         MULU     #BCH.LEN,D1
         MOVEQ    #ERR.NO,D0
         ADD.L    BV.CHBAS(A6),D1   POINT TO CHANNEL ENTRY
         CMP.L    BV.CHP(A6),D1
         BCC.S    SPEC_ERR          ERROR IF NOT OPEN
         TST.L    0(A6,D1.L)        ERROR IF NOT OPEN
         BMI.S    SPEC_ERR
*
         MOVE.L   BV.RIBAS(A6),A1
         SUBQ.L   #4,A1
         MOVE.L   A1,BV.RIP(A6)
         MOVE.L   BCH.DBAS(A6,D1.L),A2
         CMPI.L   #'DBAS',FSD.HDR(A2)
         BEQ.S    DBAD_S
         SUBA.L   A2,A2             RETURN 0 IF NOT A DATABASE
DBAD_S
         MOVE.L   A2,0(A6,A1.L)     STACK DATABASE POINTER
         BSR.S    FL_LONG
         MOVE.L   A1,BV.RIP(A6)
         MOVEQ    #2,D4
SPEC_ERR
         RTS
*
FL_LONG  MOVEM.L  D1/D5-D7/A2,-(A7)
         TST.L    0(A6,A1.L)        SET A FLAG IF INT NEGATIVE
         SMI      D6
         BPL.S    FL_POS
         NEG.L    0(A6,A1.L)        NEGATE A NEGATIVE NUMBER
FL_POS   MOVE.W   0(A6,A1.L),D1     UNSTACK THE MSW
         ADDQ.L   #2,A1
         MOVEQ    #RI.FLOAT,D0      MUST NOT STACK A NEGATIVE WORD
         MOVEQ    #0,D7
         BCLR     #7,0(A6,A1.L)
         SNE      D5
         MOVE.W   RI.EXEC,A2        FLOAT THE LSW
         JSR      (A2)
         BNE.S    FL_ERR
         TST.B    D5
         BEQ.S    FL_WPOS
         SUBQ.W   #6,A1
         MOVE.W   #$0810,0(A6,A1.L) STACK 32768 AND ADD IT ON
         MOVE.L   #$40000000,2(A6,A1.L)
         MOVEQ    #RI.ADD,D0
         JSR      (A2)
         BNE.S    FL_ERR


FL_WPOS  SUBQ.L   #2,A1             STACK THE MSW
         MOVE.W   D1,0(A6,A1.L)
         MOVEQ    #RI.FLOAT,D0      FLOAT IT
         JSR      (A2)
         BNE.S    FL_ERR

         SUBQ.L   #2,A1             STACK 256
         MOVE.W   #256,0(A6,A1.L)
         MOVEQ    #RI.FLOAT,D0      FLOAT IT
         JSR      (A2)
         BNE.S    FL_ERR

         MOVEQ    #RI.DUP,D0        LSW,MSW,256,256
         JSR      (A2)
         BNE.S    FL_ERR

         MOVEQ    #RI.MULT,D0       LSW,MSW,65536
         JSR      (A2)
         BNE.S    FL_ERR

         MOVEQ    #RI.MULT,D0       LSW,MSW*65536
         JSR      (A2)
         BNE.S    FL_ERR

         MOVEQ    #RI.ADD,D0        LSW+MSW*65536
         JSR      (A2)
         BNE.S    FL_ERR

         TST.B    D6
         BEQ.S    FL_ERR
         MOVEQ    #RI.NEG,D0        0-(LSW+MSW*65536)
         JSR      (A2)
FL_ERR   MOVEM.L  (A7)+,D1/D5-D7/A2
         TST.L    D0
         RTS
         END